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1.  SCOPE 


This  document  is  one  of  a four-volume  series  entitled  "Earth 
Observations  Division  Version  of  the  Laboratory  for  Applications 
of  Remote  Sensing  System  (EOD-LARSYS)  User  (Aiide  for  the  IBM 
370/148"  (section  2) . Originally,  the  EOD-LARSYS  software  was 
written  for  execution  on  the  Univac  1108/1110  computer  at  the 
Laboratory  for  ;^plications  of  Remote  Sensing  (LARS) . The 
original  version  of  this  document  covers  the  conversion  of  the 
EOD-LARSYS  software  for  execution  on  the  IBM  370/148,  which  was 
acquired  subsequently  by  the  LARS.  The  LARS  recently  replaced 
the  IBM  370/148  with  the  IBM  3031  computer,  which  is  thoroughly 
compatible  with  software  as  altered  for  execution  on  the  IBM 
370/148.  Thus,  no  conversion  of  software  is  required  for  this 
system  to  be  operable  on  the  IBM  3031. 


This  volume  IV  contains  a listing  for  each  subprogram  within  the 
existing  EOD-LARSYS  processors  and  the  utility  subroutines.  It 
is  modeled  after  the  As-Built  Documentation  (volume  III) , inas- 
much as  the  listings  appear  in  the  same  order  as  the  subprograms 
are  documented  in  volume  III.  Table  1-1  of  volume  III  lists  the 
EOD-LARSYS  subprograms  in  alphabetical  order,  along  with  the 
processor  to  which  each  belongs.  The  processors,  by  section,  are 
as  follows; 


Section 

6 

7 

8 

9 

10 
11 
12 


Processor 

One-Dimensional  Histogram  (HIST) 

GRAYMAP 

Statistics  (STAT) 

Iterative  Self-Organizing  Clustering  System  (ISOCLS) 
Feature  Selection  (SELECT) 

Classification  (CLASSIFY) 

Performance  Display  (DISPLAY) 


Section 


Processor 


13  Data-Transformation  (DATA-TR) 

14  Statistics  Transformation  (TRSTAT) 

15  N- Dimensional  Histogram  (NDHIST) 

16  Scatter  Plot  (SCTRPL) 

17  Dot  Data  (DOTDATA) 

18  Automatic  Cluster  Labeling  (LABEL) 


Within  each  of  the  above  sections,  the  processor  driver  routine 
is  listed  first,  followed  by  the  subprogram  listings  in  alphabet- 
ical order  (the  same  order  as  they  are  documented  in  revision  A 
of  volume  III).  Utility  subprograms  are  listed  in  section  19. 

In  addition,  this  documenc  contains  subprogram  listings  for  the 
following  new  processors: 


Section 

20 

21 

22 

23 


Processor 
Data  Merge  (DAMRG) 

Ground  Truth  Data  Tape  Dump  (GTDDM) 

Ground  Truth  Tape  Conversion  (GTTCN) 

Iterative  Self-Organizing  Clustering  System  Using 
Packed  Pixel  Storage  (TESTS?) 


The  listing  for  the  EOD-LARSYS  monitor  routine,  MONTOR,  is  given 
in  section  3,  along  with  a listing  for  an  optional  monitor  rou- 
tine, MONPAC.  Provisions  have  been  made  in  MONTOR  for  the  addi- 
tion of  the  following  processors  to  the  system:  CLASY,  AMOEBA, 

Equi-Probable  Blocks  (EQUPRB),  Multitemporal  Bayes  (MULBAY),  and 
Principal  Component  Greenness  (PCG) . These,  which  will  be  a part 
of  the  EOD-LARSYS,  will  be  documented  separately. 


The  MONPAC  routine  was  created  for  use  with  the  TESTSP  processor, 
which  clusters  pixel  values  and  stores  them  in  packed  form  on 
disk  storage.  It  differs  from  MONTOR  in  that  it  stores  pixels  in 
packed  form  (one  sample  per  byte)  rather  than  in  floating  point 
(one  sample  value  every  four  bytes) , as  is  done  by  the  ISOCLS 
processor.  The  MONPAC  routine  may  be  used  with  other  processors. 

The  listing  for  MSCAN,  MONTOR' s supervisory  routine,  is  given  in 
section  4,  and  common  block  listings  are  given  in  section  5. 


2.  APPLICABLE  DOCUMENTS 


1.  Stewart,  J.;  et  al.:  EOD-LARSYS  User  Guide  for  the  IBM 

370/148  - vol.  I,  System  Overview.  JSC-13821,  LEC-12563, 
NASA/JSC  (Houston),  Aug.  1978. 

2.  Stewart,  J.;  et  al.:  EOD-LARSYS  User  Guide  for  the  IBM 

370/148  - vol.  II,  User's  Reference  Manual.  JSC-13821, 
LEC-12564,  NASA/JSC  (Houston),  Dec.  1978. 

3.  Burnell,  M.  L. ; et  al.:  EOD-LARSYS  User  Guide  for  the 

IBM  370/148  - vol.  Ill,  As-Built  Documentation.  JSC-13821, 
LEC-12565,  NASA/JSC  (Houston),  Mar.  1979.  (Revision  A to 
be  published.) 
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CALL.. 

PURPOSE. 


SYSTEM  monitor  (//  EXEC  LARSVSAA  » 
MONITORS  The  VARIOUS  SYSTEM  SUPERVISORS 


i 


ROUTINES  MSCAN 
SELECT 
ISUCLS 
UOTUATA 
GTTCN 


clsfy  DSPLAY  stat 
MIST  GRAYMP  OATATR 
TRSTAT  ndmist  SCTRPL 
LABEL  EOUPRB  MULflAY 
UAMRG 


RETURNS..  NONE 


AMOEaA  CLASY  TESTSP  GTQOM  PCG  EXIT 


implicit  INTEGER(A-H.O-Z) 
common  array 
OImENSION  array (lOhOO) 

•Ah»AY»  is  a BLOCK  OF  STORAGE  PASSED  TO  EACH  PROCESSOR  FOR  THE 
VARIA*^LE  dimensioning  OE  OTHER  ARRAYS.  THE  ARRAY  IS  NEVER  USED 
TO  “ASS  information  from  one  processor  TO  ANOTHER. 

DATA  TOP/lOf.00/ 

INCLUDE  COMBKb.LIST 

piCLUOE  COMMTfi.LIST 

C0MMON/GLOHAL/HE4O(f>3) . MAPTAP.DAT APE. SAVTAP.HMFILE.BMKEY* 

* Hisni .HlSNfcY.TRFORM.ERlPTP.EWPKEY.MAPUNT.NOFILE* 

* OkUMAP.OH'm  Us.PAGSI^.OAlFILiSTAFIL.ASAVf ASAVFL 

* .NHSTOM.NHSTF I .SCTPUN.MAPh IL 

* .OOTUNT.DOTF IL.NCHPAS.TMNbFL.BMTRFL.HlSTFL.PCMUNT. 

* CPDIInT  .PmTiINT  .kANOIO 


Hten 
MaPT AP 

DaTape  - 

SAVTAP  - 

hmeilE  - 

WMKEY  - ^ 

HISEIL 
HISKEY 


MONOOOlO 
MONOOOlO 
MON00030 
.MONOOOAO 
1MUNU0050 
IMON00060 
iMONOnOTQ 
IMONOOOSO 
MON00090 
MONOOlOO 
MONuoilo 
MON00120 
MON00130 
MUNonUo 
IMONOoISO 
IMON00160 
IMONOOITC 
MONOO] 
MONOO 
MONOOt 

mon6o< 

MONOO? 
MON00< 
MON002A0 
MON00250 

monooIgo 

MON00270 
MON002B0 
MON00290 
MON00300 
MONOOSIO 
MON00320 
MON00330 
MON003A0 
MON003S0 
MON00360 
MON00370 
MON00380 
MONO 0390 
MONOOAOO 
MUNOOMlO 
MON00420 
MON00M30 
MON00<*40 
MON00A50 
HONU0460 
MON00M70 


global  Commd'j  is  used  In  EVERY  PROCESSOR.  IT  IS  ALWAYS  IN  COPE. 

ALL  PARAmETFPS  AmE  INITIALIZED  IN  THE  MONITOR, ROUT INE  UR  BLKCOM 
EXCEPT  AS  NOTED  Ht'LOW 
DEFINITIONS 

STA’IDAPO  HEADING  PRINTED  ON  MOST  OUTPUT  PAGES. 

Fortran  unit  number  on  which  the  maptap  file  is 
written  (=2) 

UNIT  NO.  FOR  THE  image  DATA  TAPE  (®3) 

UNIT  NO,  ON  WHICH  THE  STATISTICS  FILE  IS  WRITTEN  {=1)MONOORBO 
UNIT  AiO.  ON  WrtJCM  THE  P-MATPIX  FILE  IS  WRITTEN  ( = 10)  MON00490 
TPIGGEP  INDICATING  THAT  IHE  H-MATRlX  FILE  HAS  REFN  MONOOSOO 
•">viTTEN.  CAN  HC  SET  IN  StLECT  CLASSIFY  OR  DATA-TR.  MON00510 
UNIT  NO.  ON  WHICH  THE  HISTOGRAM  FILE  IS  WRITTEN  (=13) MON00S20 

T-'iGGFR  Indicating  the  histogram  file  has  been 
•wniEN.  SET  IN  HIST  PROCESSOR. 

TRFORM  - UNIT  NO.  ON  WHICH  THE  TRANSFORMED  IMAGE  IS  WR-ITTEN 
THE  L)ATA-TKANS^  0RM4T  lO'J  PROCESSOR.  (*l4) 

ERIPTP  - LIMIT  NO.  ON  WHICH  The;  ISOCLS  PROCESSOR  WRITES 
CLNSTFR  statistics  FOR  ThF  ERIPS  SYSTFM.  (=1S) 

ERPKEY  - TRIGGFR  Ii'JIjICaT  ING  THAT  THE  ERlPS  INTERFACE  TAPE 
HAS  PFEN  WkITTFN, 

MaPUNT  - UNIT  NO.  ON  WHICH  THF  ISOCLS  OR  DISPLAY  PROCESSOR 
W«ITFS  The  CLUSTERED  OR  CLASSIFIED  DATA 
TO  hE  displayed  on  THE  PMlS  DAS 
NOFILF.  - Nfi.  OF  files  w-niEN  On  unit  Ih  (MAP  OUTPUT  TAPE) 
py  display  and/or  ISOCLS 
SL  T F.  IThEr  in  IsuCLS  OR  DISPLAY. 

PEGiNNiNG  ADDRESS  FOR  THE  RANDOM  ACCESS  HIGH  SPEED 


peal 


DWUMAD 

time; 


drum  file,  this  file  is  USED  AS  A SCRATCH  FILE  IN 
StVFPAu  PROCESSORS.  kEEKhEnCES  TO  SYSTEM  ROUTINES 
• i-rfad*  and  •R.pIIE*  access  ThIS  FILE. 

DPMwnS  - NO.  OF  •.•'ORIIS  AvaILArLE  on  The  random  access  filf.. 
PAGSI7  - NO.  OF  LlMtS  AVAlLAHLt  FOR  PRINTING  ON  A RAGE. 
DATFIL  - Nil.  OF  F;-0-F*S  TO  HE  RFAO  OVF  P HY  TAPFPD  ROUTINE  IN 
DAIK-W  TO  POSITION  THE  IJATA  tape  Iu  DtSIPED  FILE 
STAFIL  - NO.  OF  E-O-F'S  TO  S^IP  OYER  TO  POSITION  STaT  FILE') 


MUNOOSJO 
MON005A0 
BYMON00S50 
MON00S60 
MON00570 
MON00580 
MON00S90 
MON00600 
MONOOblO 
MON00G20 
MON00630 
MONOObAO 
MONnobSO 
monoOGGO 
MUN00670 
munoopbo 
HON00690 
RON00700 
MONU0710 
MON00720 
HON00730 
MON007R0 
MON007S0 
MON00760 


FILE  MONTOR 


r* 

r* 

c* 

rsENO 


■-0-F  S TO  SKIP  OVER  TO  POSITION  OOTFlL  FILE 

'hannEls  per  pass 

f-O-F'S  To  SKIP  OVER  FOR  THFORM  FILE 


PUNCH  - UNIT  NO.  FOP  CakO  PUNCH  FILE 
CpOUNT  - UNIT  NO.  FOR  CAHO  KEAOEH 

RANOIO  - SCRATCH  UNIT  F OH  hREAO  AND  RWRITE  ROUTINES 
DBUG«-1 

SYSTEM  HOUTINE  RINIT  ASSIGNS  THE  RANDOM  ACCESS  DRUM  FILE. 

-ORUMAO—  IS  the  address  TO  BEGIN  WRITING 

-DHMWDS-  IS  THE  NO.  OF  WORDS  AVAILABLE  ON  THE  DRUM  FILE. 


ASAV  - Ui'-IT  NO.  ON  WHICH  TRSTAT  WRITES  THE  TRANSFORMED  MON00770 

^ STATS  ^ MONOOTflO 

ASAVFL  - NO.  OF  E-0-F*S  TI  SJIP  OVER  TO  POSITION  TRANSFOHMEO  MON00790 
STATS  MONOOaOO 

OOTUNT  - UNIT  NO.  ON  WHICH  DOT  DATA  FILE  (OOTFIL)  IS  WRITTEN  MONOftSlO 
OOTFIL  - no.  OF  l-O-F  S TO  SKIP  OVER  TO  POSITION  OOTFlL  FILE  MONOOR20 

NCHPAS  - NO.  OF  channels  PER  PASS  MONO0830 

TPNSFL  - NO.  OF  E-O-F'S  To  SKIP  OVER  FOR  THFORM  FILE  MONO08R0 

HMTJtFL  - NO.  OF  E-O-F'S  TO  SKIP  OVER  FOR  bMFIL  FILE  MONOOBSO 

HISTFL  - NO.  OF  E-O-F'S  TO  SKIP  OVER  FOR  HlSFlL  FILE  MONOOhGO 

PUNCH  - UNIT  NO.  FOP  CakO  PUNCH  FILE  MONOOR70 

ChDUNT  - UNIT  NO.  FOR  CAHD  REAOEH  MONOOBSO 

RANOIO  - SCRATCH  UNIT  FOR  rREAD  AND  RWRITE  ROUTINES  MON00890 

MONOOROO 

DBUG«-1  MON00910 

MOnO09<0 

SYSTEM  ROUTINE  RINIT  ASSIGNS  THE  RANDOM  ACCESS  DRUM  FILE.  MON00930 

MON009R0 

-ORUMAO—  IS  the  ADDRESS  TO  BEGIN  WRITING  MON00950 

-DRMWDS-  IS  THE  NO.  OF  wOROS  AVAILABLE  ON  THE  DRUM  FILE.  MON00960 

MON00970 

THE  following  PROCESSORS  USE  THE  RANDOM  ACCESS  DRUM  FILE  FOR  SCRATMON00980 

-Tsocls-  m5n009?5 

-nlSPLY-  MONO} 000 

-SELECT-  MONOloiO 

MON01020 

-GRAYMP-  MONO jo 30 

-SIGEXT-  MONOl0<»0 

MONOIOSO 

define  file  22(2100»200»Uf ID)  MGN01060 

DRUMADsl  MONU1070 

OK:'-'OS»4?oonn  monoiobo 

JRITE (22'1)DRUMAD  MON01090 

CONTINUE  MONO 1100 

TIME  s 0,  MONO ij 10 

CALL  CLOCK (0)  MONOll|0 

CALL  mSCAN(JGO.DHUG)  MONOljSO 

60  TO  (?0,Mn,hn.HO,100»120,U0.160.175.1ftO»200*220»2MO»260f  MONOjl^^O 

» 2RO.;j90.300,310»3?0.330.3<»0,3b0.360.370)  . JGO  MONOllSO 

MONO 1 160 

continue  mono 11 70 

CALL  STAT (APPAY.TOP)  MONOjlBO 

CALL  CLOCK  ( 1.  '$STA'  ) MONOllRO 

GO  TO  10  MONO  1200 

MONU1210 

MON01220 

continue  MONOj230 

CALL  CLSFYIAPRAY.TOP)  MON012R0 

CALL  CLOCK  ( 1.  'SCLA*  > MON01250 

GO  TO  10  M0N0j260 

MONO j 270 
M0NU12B0 

continue  mono I 290 

CALL  OSOLAY( ARPAY.TOP)  MON01300 

CALL  CLOCK  ( 1.  'SDIS'  ) MON01310 

60  TO  10  MONO  1320 

MON01330 
MONO} 340 

CONTINUE  MON013S0 

CALL  StLECT(APHAY.TOP)  MON0}360 

CALL  CLOCK  ( 1,  'SSEL'  ) MON01370 

60  TO  10  MONO 1380 


CONTINUE 

call  mist (ARRAY. TOP) 

call  clock  ( 1.  'SHIS'  ) 
GO  TO  To 

GO  HERE  FOR  ISOCLS 

continue 

call  ISOCLS(ARPAY.TOP) 

call  clock  ( 1.  'SISO'  ) 
GO  TO  10 


MON01020 
MONO j030 
MONO  1040 
MONOIOSO 
MGN01060 
MON01070 
MONOIOBO 
MON01090 
MONO 1 100 
MONoiiio 

MONO I 120 
MONOllSO 
MONO j 140 
MONOllSO 
MONO 1 160 
MON01170 
MONO j} 80 
MONO I I 90 
MON01200 
MONU1210 
MON01220 
MONO 1230 
MON01240 
MONO  1250 
MONO 1260 
MONO j 270 
M0NUI2B0 
MONO1290 
MUN01300 
MONO 1310 
MONO 1320 
MON01330 
MONO} 340 
MON0}3S0 
MONO  1360 
MON01370 
MON01380 
MON0}390 
MON01400 
MON01410 
MON01420 
MUN01430 
MON014**0 
MONO  1450 
MONOlMbO 
MON0l470 
MONO  J«.H0 
MONO  1490 
MOMOISOO 


FILE  MONTOR 


C 

150 

f 

r 


fiO  H?‘^E_fOR  GRAYMAP 
IR 

:k  ( 1* 


oo  rw 

HO  CONTINUF 

CALL  GRAYMPI 
0 CALL  CLOC 


AhiRAYtTOP) 

•SGRA* 


) 


60  tO'^0 
GO  here  for  OATA-TPANSFORMATION 


HO  CONTI  HUE 

CALL  OATATR«APPAY.TOP» 

170  Call  clock  ( i.  'soat* 
GO  TO  To 

c* 

r#  GO  HERE  FOR  SlGEXT  MODULE 

r# 

175  CONTINUE 
C ***  SlGEXT 


170 

r 
c 
f 


CLOCK  I 1.  'SSIG*  ) 


GO  to'’!to 
GO  MERE  FOR  TRSTAT 


iflo  continue 

CALL  TRSTAT(4RRAY»T0P) 

190  call  clock  < 1*  'STRS* 

GO  TO  10 
C 

r GO  HERE  FOP  NDmIST 

C 

200  CONTINUE 

call  nDHIST<APHAY»TOP) 

210  CALL  CLOCK  ( 1«  'SNOm* 

GO  TO  To 
C 

r GO  HERE  FOR  SCTRPL 

C 

220  CONTINUE 

CALL  SCTRPL (ARRAY. TOP) 

230  CALL  CLOCK  ( ],  'SSCT* 

GO  TO  10 
r 
C 

C GO  MERE  FOR  OOTDATA 

C 

2AO  continue 

CALL  OOTOAT(A»R4Y.TOP) 

250  CALL  CLOCK  ( 1,  *SD0T* 

GO  TO  To 
r 

c GO  HEBE  FOR  LABEL 

r 

2ft0  CONTINUE 

CALL  LABEL (ARRAY. TOP) 

270  CALL  CLOCK  ( 1.  "iLAB» 

GO  TO  To 


r 

c 

r 

2H0 

285 

r 

r 

r 

29n 

295 

r 

r 

c 

TOO 

70S 


GO  MERE  FOR  EOUI-PPOHABLE  BLOCKS  CLASSIFIER 
CONTINUE 

CM.L  EOUPRB(ARRAY.TOP) 

CALL  CLOCK  ( I.  'SEOU*  ) 

GO  TO  10 

GO  HERE  FOB  multi-temporal  CLASSIFIER 
continue 

CALL  MULHAY(ARBAY.TOP) 
call  clock  ( 1.  •SM'JL*  ) 

GO  TO  10 

GO  MERE  FOR  GROONO  TRUTH  TO  MAPFlL 
continue 

CALL  GTTCN(4PR4Y.T0P) 

CALL  CLOC*  ( 1.  "sGTT*  ) 

6U  TO  10 


MONO] 
MONO 
MONO] 
MONO) 

mono! 

MONO 
MONO 
MONO), 
MONOh 
MON016I 
MONO  16* 
MONOl^' 
mono) 

MONO] 

mono) 

MONO 

mono) 
mono! 

MONO I j 
MONO! 
MONO 
MONO 
MONO) 
MONOl 
MONO  1770 
MONO 
MONO 

MONO 

MONOlHiO 
MONOlOtO 
MONOiaSo 
MONO  1840 
MONO18S0 
HON01860 
MUN01870 
MONO  1 880 
MONO  1890 
MON01900 
910 
920 
930 
940 


MONO 
MONO 
MONO 
MONO, 
MONO19S0 


MONO 


MONO 

MONO 


960 
MUN01970 


980 

<#90 


MON02000 
MON02010 
MON02020 
MONU2Q30 
MON02040 
MONO20S0 
MON02060 
RON02070 
MON02080 
M0N02090 
MON02j00 
MUN021 10 
MON02l|0 
MUN02130 
MON02i40 
^'ON02)50 
RON02160 
MON02170 
MCJN021  HO 
MONO21SI0 
'‘ON0P200 
MOiOPPlO 
MON02220 
MON0P23O 
RONOi'.?40 
MON02250 
MON02260 
MUN02270 
MON022M0 


7 


riLC  MONTOR 


r 

^ 310 

Ilf. 

r 

r 

f.  . 

3?0 

125 

r 

r 

330 

135 

r 
r 
r 

340 

145 

r 

r 

r 

350 

155 

r 

r 

r 

360 


GO  HSPE  FOTR  iMAGF  DATA  MERGE 


continue 
call  DAMRG 
CALL  CL 


C 

r 

r 


370 


. G(«PHAy*T0P) 

CLOCO  ( 1»  'SOAM*  » 

GO  TO  10 

GO  HERE  FOR  AMOEGA 

continue 

6aLL  AmOE«A(ARPAV»TOP) 

CALL  CLOCK  ( 1.  '5AM0*  ) 

GO  TO  10 

GO  HERE  FOR  CLASV 

continue 

CALL  CL AST  I ARRAY, TOP) 

rO*Vb  * **  'SCLS*  » 

GO  HERE  FOR  TESTSP 

CONTINUE  _ . 

CA|  L TESTSP(AHRAY,T0P) 

CALL  CLOCK  ( I,  »$TES'  1 
GO  TO  10 

60  HERE  FOR  GROUND  TRUTH  DOT  UNLOAD 

CONTINUE  

CALL  GTODH<A4«AY,TOP» 

CALL  CLOCK  ( 1,  ’SGTO*  » 

GO  TO  10 

GO  HERE  for  PCG 

CONTINUE 

call  PGSTAT (ARRAY.TOP) 

CALL  CLOCK (1,*»PCG») 

GO  TO  10 

GO  HERE  TO  EXIT 

TF  ( nofile  .GT, 

END 


MONO! 
MONO  I 
NUNUj 
MONOl 
MONO, 
MONO! 
MONO* 
mono! 
MONO< 
HONOi 
MONO< 
MONO? 
HON02M1C 
M0N024|( 
MQN0243C 
M0NU244< 
MON0245C 
M0NU|460 
M0N0247f 
MONOr 
MONO? 
MONO? 
MONO( 
MONO? 
MONO? 
MON02540 
MONOEISO 
MON02560 
MON02570 
MON02580 
MON02590 
MONU2600 
MON02610 


0)  rewind  MAPUNT 


MONO 
MONO 
MONO 
MONO 
MONO 
MONO 
MONO 
MONO_ 
MON02700 
MON02710 
MON02720 
MON02730 
MON02740 


I** 

>6S 

>680 

$690 


5 


FILFl  CLOCK 


FORTRAN  A 


SUBROUTINE  CLOCK <TIMF) 
INTtGER  t]«FR 
tl»^|l  ■ TImFRCO) 

IlMF  « (T1mF1/N0000.)-TIMC 

RETURN 

FNO 


CLOOOOlO 

cLooooeo 
CL00003 
CLOOOOA 
CLO9OOS 
CLO 


9 


riLC  MONPAC 

//montop 


C*UL..  SY5T€M  MONITOK  <//  exEC  LAPSYSAA  ) 
PURPOSE.,  hOnITOPS  The  various  system  supervisors 

ROUTINES  MSCAN  ClSFY  OSPLAY 

jf  _ 


returns.,  none 


STA? 

OATATR 
SCTRPL 

EOUPHM  MULBAY 

GTTCN  UAMRG 

AMOEbA  ClASY  TESTSP  GTODM  PCG  EXIT 


OOTUATA 


MIST  GRAVMR 
TOSTAT  NUmIST 
LABEL 
'IRG 


implicit  INTFr,ER<A-M.O-Z) 
Cn^^ON  4HRAY 
OImENSION  ARPAYdOGOO) 


• iAMRAY' 

• vawiamlE 

• TO  PASS 


IS  A BLOCK  OE 
OlMFNsinuiN'j 
iNFOMMflTION 


STOWAGE  passed  to  EACH  PPOCES 

Of  otmfw  arrays,  the  array  is 

FROM  ONF  PROCESSOR  TO  ANOTHER. 


SOR  FOR  THE 
NEVER  USED 


DATA  TOP/10(SnO/ 
INCLUDE  COMriKfe.LlST 


r# 

C.^ 

r« 

r* 

r» 

r* 

r<* 

r« 

r* 

f* 

r* 

r* 

c* 

f • 
r* 

r« 

r* 

c* 

c^ 

f« 

c» 

c« 

c« 

r* 

r* 

c« 

c* 

r* 

C* 

C* 

r* 

f* 

c« 

r* 

c* 

r* 

c* 


TNCLUOf  COMmtm.LIST  , ^ 

CO^’''ON/(,LOHAL/«r.4n{»j31  .MaPTAP.OATAPE.SAVT  AP.BMF  ILE.BMKEY. 

• HjSFll  .H1SKEY,T-FOHm.6RIPTP.£RPrEV.MAPUNT.N0FIL£. 

• n^UM40«f)PM-/US.RA(,Sl/.U4  tFlLfSTAFlL.ASAV.ASAVFL 

• .|^l-lSTU'i.Nr^sT^  1 •SCT‘'0>I.MtPf  IL 

• .UOTurJT  .UOTElL.’JrMPAS.TWNbFL.BHTREL*HlSTFL»PCHUNT* 

• CRUUNT  .prT'iM  .m4*j0I0 


GLOHAL  CGmmo  I IS  USEO  Iig  tVtMY  PPOCESSOR.  IT  IS  ALWAYS  IN  CORE. 

VE  INITIALUEO  IN  The  MUN  I TOR,  ROUTINE  OR  HLKCOM 

mELOw 


EXCEPT  AS  NOTEO 
Dtf INIT IONS 
HEAD 
maPT  ar 


STAOOAwn  HEADING  PRINTED  ON  MOST  OUTPUT  PAGES. 
fiiRTRAN  UNIT  NUMBER  ON  rmICh  ThE  maPTAP  FlLt  IS 
.RlTTEN  (»Z) 

OATAPE  - UNIT  NO.  Fur  TmE  image  OATA  tape  <«3» 

SAvTap  - UNIT  NO.  ON  RHICH  TmE  STATISTICS  file  is  rRITTFN 
rmpilf  - u^liT  NO.  ON  rhiCm  tmk  b-matrix  file  IS  RRITTEn  ( 
p-ieEY  - TPIOGEo  Indicating  that  The  h-maTrTx  f ILE  has_meen 


I»1 

10) 


real 


nrITTFN.  Can  Bt  SET  IN  StLECT  CLAsSIfY  OR  QATA-TR, 
HISflL  - I'NjT  NO.  On  RhICh  the  histogram  EIlE  is  WRITTEN  (*13 
HlSKEY  - Tp}r,(,rR  InOICaTInU  TmE  HISTOuRAM  FILE  MAS  BEEN 
.kITTEN.  SeT  irj  hist  processor, 
twfokm  - unit  no.  UN  I.H1CH  The  t-ansfowhed  Image  is  written  h 
The  naTA-TkAHSK)RMAT10N  PROCESSOR. 

EHIPTP  - Uf'IT  NO.  ON  which  The  ISuCLS  processor  WRITES 
CLU«;TFR  STATlSllCS  FOW  THE  ERIPS  SYSTEM.  («15) 

PrhkEY  - TRIG'i*-R  INuICaIIno  that  THE  lRIPS  INTERFACE  TAPE 
HAS  ><^►0  >KlTTt.N, 

maPUMT  - UNIT  NO.  ON  WHICH  THE  ISOCLS  OR  DISPLAY  PROCESSOR 
WHITES  The  CLUnT^REO  0«  CLASSIFIED  DATA 
TO  ptl-  nlSPLAYtO  ON  The  PMIS  OAS 
NOFILF  - H<,.  or  FILES  RRITTfrj  ON  ONIT  16  (MAP  OUT  »UT  TAPE) 
nY  DISPLAY  ANO/OR  ISOCLS 
St- I either  in  ISuCLS  Ok  DISPLAY. 

FOf  * 


OWUMAD 

TIME 


- HFg  I^^'ING  AuDRcSS  FOR  THE  RANDOM 


access  high  speed 

SCRATCt 


FILE  IN 
ROUTINES 


OKiit  file.  This  FILF  is  USED  AS  A 
sEt/fRfiL  processors.  refermiCes  to  system 
• i^REAOi  ano  •R-RlTr  * ACCESS  This  f IlE. 
nRM»t)«;  — .|U.  (O  *()RiiS  available  UN  THt  RANDOM  ACCESS  file. 
PAGSl?  - NO*  or  LiNrS  AVAILAhLE  EOR  PRINTING  ON  A PAGE. 
OATFIL  - NU,  OF  F-ii-F'S  To  bE  RA  AU  OVER  hY  I ARf  WU  ROUTINE  IN 
rwurs  TO  position  The;  o-IA  Tape  to  otSlREU  fit 
STAFIl  - NU.  or  t-u-F‘S  TO  SKIP  OvFr  to  position  stat 


LEM 


MONOOOlO 
MONOOOfO 
IMON00030 
mONOOOwO 
mONOOOSO 
MONO 0060 
mONOOOTO 
MONOooeo 
MON00090 
MONonioo 
mono 01 10 
MONOoiSo 
MONoniJO 
mdnuoIao 

iMONOOlSO 
IMONU0160 
IP.ONUOITO 
MONOOIBO 
MONO 01 90 
MONOO^OO 
MUN00210 
MON00220 

munoo23o 

MONU02<»y 

MON002S0 

MON002bO 

MON00270 

MOUO0280 

MON00290 

MON00300 

MONon3io 

MON00J20 

MON00330 

MON003AO 

MON00350 

MON00360 

MON00370 

MON00360 

MON00390 

MOOOOROO 

MONOORIO 

MON00M20 

MGN00R30 

MUNOOMRO 

MONOOmSO 

MON00^60 

MONOOM70 

>MUN0GR80 

MONOOAVO 

MONOOSOO 

MONOOSlO 

I)mON00S20 

MONU0530 

MON005A0 

lYMONOOSSO 

MJN00S60 

MON00570 

MON005BO 

munOOS-30 
MON00600 
MON00610 
MON00620 
MONOOB30 
M()N006‘*0 
MON006S0 
MUN00B60 
PONO0670 
MONOObBO 
MON006R0 
MUN00700 
MONO0710 
MUNOO  tZO 
MON00730 
MONOO  /MO 
MU:J00  7SO 
MON00760 


PILE  MONPAC 


C* 

C« 

C» 

r* 

c* 

r* 

r* 

r* 

r* 

r* 

c» 

c* 

c* 

C^EMO 

r* 
c* 
r* 
r# 
r* 
r* 
r* 
r* 

C* 

r* 

r* 
c* 
r* 
r» 


DOT  OATA  file  (UOTFIL)  IS  WRITTEN 
SKIP  OVER  TO  position  DOTFIL  FILE 


ASAV  - UNIT  NO.  ON  WHICH  TRSTAT  WRITES  THE  TRANSFORMED 
stats 

ASAVFL  - NO.  OF  E-O-F'S  TI  SJIP  OVER  TO  POSITION  TRANSFORMED 
STATS 

OOTUNT  - UNIT  NO.  ON  WHICH 
nOTKIL  - NO.  OF  E-O-F  S TO  _ _ 

NCHpfts  - NO.  OF  Channels  pep  pass 

TWWSFL  - NO,  OF  E-O-F *S  TO  SKIP  OVER  FOR  TRFORM  FILE 

MmTXFL  - NO.  OF  E-O-F'S  TO  SKIP  OVER  FOR  BMFIL  FILE 

HISTFL  - NO.  OF  E-O-F'S  TO  SKIP  OVER  FOR  HISFlL  FILE 

PUi'JCH  - UNIT  NO.  FOR  CAPO  PUNCH  FILE 
CPDUNT  - UNIT  NO.  FOR  CARO  READER 

RANDIO  - SCRATCH  UNIT  FOR  RREAU  AND  RWRITE  ROUTINES 


0BUG»-1 

system  ROUTINE  RINIT  ASSIGNS  THE  RANDOM  ACCESS  DRUM  FILE. 

-DRIIMAO—  IS  the  address  TO  BEGIN  WRITING 

-ORMHOS-  IS  THE  NO.  0^  wORDS  AVAILABLE  ON  THE  DRUM  FILE. 

USE  THE  random  ACCESS  DRUM  FILE  FOR 


10 


20 


30 

r 

r 


40 


SO 

r 

r 


70 

r 

r 


60 


«o 


RO 

r 

r 

ion 

110 

r 

r 

c. 

120 
1 30 
C 


THE  following  procfssors 
-ISOCLS- 
-DISRLY- 
-SELECT- 

-graymp- 

-SIGEXT- 

OEFINF  file  22(640, 200, U*I0> 

0RUM4D=1 

nR.vyOs=i2ftnoo 

WrITF(22'1)OPUHAO 

continue 

TIME  = 0. 

call  clock (TIME) 
call  mSCAM(JGO.DHUG) 

GO  TO  (20,40,60,80,100.120.140,160,175,180,200,220,240,260, 
* 2ho.2S»O,300,31U,3?0,330,340,350,360,370)  , JGO 

CONTINUE 

call  STAT (ARRAY, TOP) 

CALL  CLOC^  ( 1,  '5STA*  ) 

GO  TO  10 

CONTINUE 

CALL  CLSFY(ARRAY,TOP) 

CALL  CLOCK  ( 1,  '5CLA'  ) 

GO  TO  in 

CONTINUE 

CALL  USPL AY(ARRAY,TOP) 

CALL  CLOCK  ( 1,  'SDIS*  ) 

GO  TO  10 

CONTINUE 

call  gelFCT(arpay,TOP) 

CALL  CLOCK  ( 1,  '1.SEL'  ) 

GO  TO  10 


continue 

CALL  HIST (ARRAY, TOP) 
call  CLOCK  ( 1, 
GO  TO  10 

GO  HERE  FOR  ISOCLS 


'SHIS'  ) 


continue 

CALL  ISOCLS(ARRAY,TOP) 

CALL  CLOCK  ( 1,  '4ISO' 
GO  TO  10 


MON00770 
MONO 0760 
MON00790 
MON 00 800 
MONOOHIO 
MONO0820 
MON00B30 
MON00B40 
MON00850 
MON00B60 
MON00870 
MON00A80 
MON00890 
MON0090Q 

monoomIo 

MON00920 
MON00930 
MON00940 
MON00950 
MUN00960 
MON00970 
SCRATMON00980 
MON00990 
MONOIOOO 
MONOlOlO 
MON01020 
MUN01030 
MONO 1040 
MONO 1050 
MONO  1060 
MON01070 
MON01080 
MON01090 
MONOliOO 
MONO  11 10 
MONoiiJo 
MONO 1130 
MONO 1140 
MONO! 150 
MONO! 160 
MON01170 
MONO  11 80 
MONOl 190 
MONO 1200 
MON0i210 
MONO 1 220 
MON01230 
MONO  1240 
MONO  1250 
MONO  1260 
MONO  1270 
MON01280 
MONO  1290 
MON01300 
MONO  1310 
MONO  1320 
MONO  1330 
MONO  1340 
MONO  1350 
MONO  1360 
MONO  1370 
MONO  1 380 
t ON01390 
MONO  1400 
MON01410 
MONO  1420 
MONO  1430 
MONO  1440 
MONO  1450 
MONO  1460 
MONO  1470 
MON01480 
MONO  1490 
MON01500 
MON01510 
MONO  1520 


J 


PiLf.  MONPAC 


c 

60  HEPE  FOR  GRAYMAP 

MONO  1530 

140 

C0N7I^^UE 

MONO  1540 

CALL  GPAYMi>(A»PAY,TOP) 

MONO  1550 

150 

CALL  CLOCK  ( 1,  'SGRA*  ) 

MONO  1560 

60  TO  lo 

MON01570 

r 

MONO  1580 

r 

60  HERE  FOR  DATA-TPANSFORMATION 

MONO  1590 

r 

MONO  1600 

. 160 

continue 

MON016iO 

CALL  1)ATAT«(ARPAY»T0P) 

MONO  1620 

170 

CALL  CLOCK  ( 1,  'JOAT*  1 

MONO  1630 

GO  TO  To 

MONO  1640 

r* 

MONO  1650 

r* 

60  HERE  FOR  SIGEXT  MODULE 

MONO  1660 

r* 

MON01670 

17S 

continue 

MONO! 680 

r ***  SIGEXT 

MON01690 

176 

call  clock  < 1,  '$516*  ) 

MON01700 

r 

60  TO  10 

MONO} 710 
MONO  1720 

r 

GO  HERE  FOR  TRSTAT 

MONO  1730 

r. 

MONO  1740 

IHO 

continue 

MONO i 750 

CALL  TwSTAT(ARhAY*TOP) 

MONO! 760 

190 

CALL  CLOCK  { 1.  *$TRS'  > 

MONO1770 

GO  TO  10 

MONO  1780 

r 

MONO  1790 

C 

GO  HERE  FOR  wOnlST 

MONO  1800 

r 

MON01810 

200 

continue 

MONO  1820 

CALL  NUHIST ( AR»AV«T0P) 

MONO  1930 

?10 

CALL  CLOCK  ( 1,  *$NDH*  » 

MON01840 

GO  TO  10 

MON01950 

r 

MONO  1860 

r 

GO  HERE  FOR  SCTRPL 

MON01870 

c 

MON01890 

2?0 

CONTINUE 

MONO  1890 

call  SCTRPL (ARRAY»T0P) 

MONO  1900 

230 

CALL  CLOCK  ( 1,  ‘SSCT*  ) 

MON01910 

GO  TO  10 

MONO  1920 

r 

MONO  1930 

r 

MON01940 

c 

GO  HERE  FOR  DOTDATA 

MONO  1950 

r 

MON01960 

240 

continue 

MON01970 

call  OOTDAT (array. TOP) 

MONO  1980 

250 

CALL  CLOCK  ( 1,  '$DOT*  ) 

MONO  1990 

GO  TO  10 

MON02000 

r 

MON02010 

r 

GO  HERE  FOR  LABEL 

MON02020 

c 

MON02030 

?frO 

continue 

MON02040 

CALL  LABEL (ARRAY, TOP) 

MON02050 

270 

CALL  CLOCK  ( 1,  'SLAB*  ) 

MON02060 

GO  TO  10 

MON02070 

r 

MON02080 

r 

GO  HERE  FOR  EOUI-PROBABLE  BLOCKS  CLASSIFIER 

MON02090 

r 

MUN02100 

260 

continue 

MON02n0 

Call  eourrb( array, top) 

MONO 2 120 

2«5 

call  CLOCK  ( 1,  'SEQU'  ) 

MONU2130 

GO  TO  10 

MON02140 

r 

MONO 2 150 

c 

60  HERE  FOR  muLT I-TEMPORAL  CLASSIFIER 

MON02160 

r 

. 

MUN02170 

290 

CONTINUE 

MON02180 

CALL  MULflAY (ARRAY. TOP) 

MUN02190 

295 

call  clock  ( 1,  »SMUL'  > 

MON02200 

(lO  TO  10 

MON02210 

r 

MON02220 

r 

GO  HERE  FOR  GROUNO  TRUTH  TO  MAPFIL 

MONU2230 

c 

• 

MON02240 

300 

CONTINUE 

MONO2250 

CALL  onCN(  ARRAY, TOP) 

MON02260 

305 

call  CLOCK  ( 1,  *$GTT'  ) 

MON02270 

()0  TO  10 

MONO2280 

riLE  HONPAC 


c 

HON02290 

c 

GO  HErtE  FOT»  IMAGE  DATA  ME«GE 

M0N02J00 

3in 

continue 

MON023lO 

CALL  OAMNG(A»Par.TOP) 

MON02320 

31S 

C«LL  CLOCK  ( 1,  ‘SOAM*  » 

MON02330 

r 

GO  TO  10 

M0NU2340 

MONU2350 

C 

GO  HERE  FOR  AMOEBA 

HONU23bO 

c 

MON02370 

320 

continue 

CALL  AMOfOA ( ARRAYtTOP) 

Call  cluck  ( i.  '$amo‘  > 

MON02380 

MON02390 

325 

MON02400 

60  TO  10 

MON02410 

r 

MON02420 

r 

GO  HERE  FOR  CLASY 

MOn02430 

c 

MON02440 

330 

CONTINUE 

MON02450 

CALL  CLASY<ARRAY,T0RJ 

MONO 2460 

335 

CALL  CLOCK  ( 1,  'SiCLS*  ) 

MON02470 

GO  TO  10 

H0N024flQ 

r 

MON02490 

r 

GO  HERE  FOR  TESTSP 

MON02500 

r 

MON02S10 

340 

CONTINUE 

MON02S20 

CALL  TESTSPJARRAY.TOP) 

MON02530 

345 

CALL  CLOCK  ( 1«  *$TES*  ) 

MON02540 

60  TO  10 

HON02550 

C 

MON02560 

C 

GO  HERE  FOR  GROUND  TRUTH  DOT  UNLOAD 

MON02570 

C 

MON02580 

350 

CONTINUE 

M0N02590 

CALL  6T00M( ARRAY, TOP) 

M0N02600 

355 

CALL  CLOCK  < 1,  ‘SGTO*  ) 

M0N02610 

60  TO  10 

MON02620 

C 

60  HERE  FOR  PCG 

MON02630 

r 

MON02640 

r 

MON026S0 

360 

CONTINUE 

call  ogstat (AOdAY.TOP) 

HONU2660 

MON02670 

call  clock (1. 'PCG* ) 

MON02680 

M TO  10 

MON02690 

C 

GO  HERE  TO  EXIT 

MON02700 

r 

MON02710 

r 

MON02720 

370 

TF  (NOFILE  ,6T.  0)  REWIND  HAPUNT 

M0N02730 

END 

MON02740 

4 . MSCAN 


FILE  MSCAN 


SUHOrtuTlNF  M«;CtN(MriO*DPUG> 

I'^t'LICIT  iNTFCie'w  (ft-H.0-7) 

DIMENSION  C(V'T6H(?4)  ,COmENT(1S)  «DATE(3) 
1 ♦ «€OmS)«  Htn^(lS)  .ACAMD<20) 


CALL.. 


CALL  MSCAN (MGOfOaUG) 


continue 

A>«GS..  JGO 
DHilG 


- PPOCFSSOW  PTR 

-DEBUG  KET  -1  FIPST  ENTRY 

n - iNCLDDt  FLASH 
1 - EXCLUDE  FLASH 


PURPOSE.,  analyzes  all  monitor  control  CAROS 


returns.. 


J60  - 1 
7 


CONTINUE 


- 1 «STAT 
P SCLASS 
3 'DISPLAY 
A 'SELECT 
S 'rilSt 
h 'ISOCLS 
7 SGPAYMAY 

S i^data-transformation 

D 'SIG  EXT 

10  «TPSTAT 

11  fNOHlST 
1?  'SCTRHL 
13  'OOTOAT 
lA  SLABEL 

15  '.EOUPWOd  BLOCKS 

16  'MULTI-TEHPORAL  BAYES 

17  *.Gh;0UM)  TP'ITh  TO  CLUS 
IS  'DATA  merging 

IR  'AMOEBA 


L BAYES  CLASSIFIER 
TO  CLUSTER  MAP 


20  'CLASY 

21  'TESTSP 

22  SGTDDM 

23  ^PCG 
2“  ■‘.EXIT 


FOUlVALENCt  (HPOl(l),  HtAiM:,)),  (DATE(l).  H£AD(22»)f 
1 ^ (HrD2(l).  HtADO'?)).  (CUMENT(I).  HEAD(A8)) 

Include  compka.list 

COmMON/GLOHAL/HE AO(63) .M APT AP . 0 AT APE . S A VT AP . BMP  I LE . BMKE Y » 

* Hist-  II  ,HISKFY,1PK0KM,FRIPTP.ERPKEY«MAPUNT.N0FILE. 

* ORUMaO.Opv  u-^.pAGSI/'.Ua  IFIL.STAFIL*  ASAV.  ASAVFL 

* .NHSTIIN.N-ISTF  I .SCTP'IN.mAPE  IL 

* .nnru  JT.'jnrnL.urtiPAS.TRNSFL.BMTPFL.BlSTFL.PCHUNT. 

* CROUnT.PRTU'JT  .RANDIO 

0 

COM^nrj  /TAPF-n/  lUf.'IT.  1 F wS  T.  F5C  an.  s amend.  S am  INC.  READY.  NSC  AN. 

* LlNC,  ID120.1)  .0SI..LBUF(3U)  .JRtC(JO)  ,IbYTE(30)  .NBUFS.FILENO. 

* LlNEtiU»LI*'INC.  iSa-1P.NOCHAN.FOR.MT 
COMMON/ 1 DSTnr  / 1 ; II ) ( 2so ) 

DATtt  COOTAh  /‘'STa'.'^CLA'. 'sols'. •'♦St.L'. 'SHIS'. 'tlSO’.'SGRA*. 

* • V iuT  • . • : IkS'  . ' •mNJH*  . • + SCr  ' . 'SOOT  ' . 

* 'SLAO* . -'OL'  . ' +GTT'  . •■MjaM'  . 

* t sa-'O* , .'CLS'-.  • - TFS'  . .JOTO'  . tspcG*  . 'SFXI  •/ 

data  FF  /•FOk'^'/,  I FORtJ  / ' P' / .LThwEE/ M'/.LFUUR/ *M'/ 
lUTA  LBCD/'t  '/.- HCD/'M'/.£lCO/'£'/ 

DIMENSION  CA.>l)(h?) 


Msconolo 

MSC00020 

MSC00030 

MSC000<»0 

MSC00050 

-IMSCOOOSO 

-IMSCOOOfo 

IMSCOOOBO 

HSC00090 

IMSCOOIPO 

HSCOOlIO 

IMSCOOI20 

IMSC00130 

iMSCOoUo 

IMSC00150 

iMSCOOlbO 

1MSC00170 

IMSC00180 

IMSC0Oi90 

1MSC00200 

IMSC002I0 

IMSC00220 

IMSC00230 

MSC00240 

MSC00250 

MSC00260 

MSC00270 

MSC00280 

MSC00290 

MSC00300 

MSC00310 

M'C00320 

MSC00330 

MSC00340 

MSC00350 

MSC00360 

MSC00370 

MSC00380 

MSC00390 

MSCOOROO 

MSC00410 

MSC001.20 

MSC00430 

MSCO0A40 

1MSC00450 

•IMSCOOA60 

■IMSC00A70 

MSC00A80 

MSC00490 

MSCOOSOO 

Mscoosio 

MSC00S20 

MSC00530 

MSC00540 

MSC00550 

MSC00S60 

MSC00570 

MSC00S80 

MSC00S90 

MSCOObOO 

MSC00610 

MSC00620 

MSC00630 

MSC00640 

MSC00650 

MSC00660 

MSC0n670 

MSC00680 

MSC006RO 

MbCOOVOO 

-MSC00710 

-MSC00720 

MSC00730 

MSC00740 

MSC007S0 

-MSC00760 


-)->->  or»r> 


FILE  MSCAN 


MSC0O770 

CnnOEM  ■ ?4 

mscootro 

IF  (D^UO.GE.O)  GO  TO  10 

HSC00790 

nrtUG  » 0 

MSCOOHOO 

FOU^f  m 1 

HSCOOtUO 

SET  THE  DATE  FkO’I  RTOATE 

MSC00820 

MSC00B30 

10 

MSC008A0 

HSC008SO 

MSC00tt6Q 

MSC00870 

v/.‘«ITE  (AtHCAO) 

PEAD  AND  OECOOE  THE  rtONlTOP  CARD 

MSC00890 

SET  t'»  RREAO  Buffer 

MSCOONOO 

mscoorIo 

T*10 

tall  PEREAO(PWn*JlTt80» 

MSC00920 

RSC0O930 

MSC009A0 

MO.  PUT  THE  CAi.0  In  HUFFEH 
W*iAn(?l,Pm  (ACAHOdJ  *l*l»20) 

MSC009SO 

HSC00960 

?n 

MSC00970 

-*s 

FO^ '■' A T ( r*n A.*) 

MSC009H0 

Wi.  ITF  (wHiINlT.^S)  (ACAHO(I)  *I>1*20) 

MSC00990 

OK  w J T 

HSCOIOOO 

DF  ,UMPKU-glT.in)COOFl.COOE2 

Hscoiolo 

in 

FO - 1AT  (?AA) 

MSC01020 

PF'.  IN.J  PPIINIT 

“SCO1030 

.C00E2 

MSCOIOAO 

<.0 

F')..  ^AT  ( 1 

HSC01050 

no  so  J(’0=1  .COOOEH 

M5C01060 

Mi,ii  = j(,r) 

HSC01070 

TF  (CODTAH(JGO)  .EO,  CODED  RETURN 

MSC01080 

51 

C0'"T1MUF 

HSC01C90 

IF  (Cni'EJ  .mf.tf)  go  TO  55 

MSCOllOO 

WE  i)( '10.52)  CAVD 

MaCOl  no 

WE  'l'jo  in 

MSC01120 

FOw.'AT  < m*,F2Al  ) 

MSC01130 

roL=n 

MSCOllAO 

1 F 1w=  NXTCH-i  (Ctwn.COL) 

MSC01150 

IF  (LFIw.FO.LFO-'W)  F')RhT*2 

MSCOllftO 

IF  (LFO=^.FO.(-T>-wKF)  F0RMT*3 

MSC01170 

IF  (LF  nw.F.j.i  f n I.v)  ► (J,vyT  = 4 

HSC01180 

1 F ( L F OK  . F 0 . I> C') ) F 0«<MT  =2 

MSC01190 

IF  (1  FOW.F'i.wh(  'J)F0w.iT  = 3 

HSC01200 

IF  (lFOk.FO.F,  ■'CD)  F OwHT=A 

MSC01210 

^■0>wSD 

MSC01220 

C'iU.=Cni 

HSC01230 

(r  Aw  O.coL.  I DO ♦ NOW ) 

HSC012AO 

IF ( JIJ.gF. 1) GO  TO  20 

MSC012S0 

C'U.=col;.'»i 

HSC012G0 

IF  u;oL.LT.nn)G0  TO  53 

MSC01270 

r-o  Tn  jfo 

RSC01280 

ru'O inuf 

MSC01290 

•/-ITF  (h.feO) 

'^SC01300 

r,n  TO  ?n 

•"SCOl  310 

f>n 

FO.-^'.  It//  S».  MSCANij  PROCESSOR  CARO  REQUIRED 

AROHSC01320 

IVE  CARD  r.OT  A VALID  PROCESSOR  CARD  CONTINUING  SCAN 

••••••/IMSC01330 

MSC01340 

End 

MSC01350 

/5' 


VAGf 

J^.Va  .^UAUTY 
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COMMON  BLOCKS  AND  BLOCK  DATA 


The  coimnon  block  listings  are  given  in  this  section.  For  specific 
descriptions,  definitions  of  the  parameters,  and  processor  and 
subprogram  interfaces,  see  section  5 of  volume  III  of  this  user 
guide.  The  common  block  listings  are  given  here  in  alphabetical 
order,  as  they  appear  in  volume  III. 


COMMON/ARRAY (10600) 

COMMON/BESTKN/KPPPTS (60 ) , IPRIOR .KBEST .NCPASS 

COMMON/ BMTRX/BMATRX (450 ) 

C0MM0N/CLASS/APRFLG,BMC0MB,BMFEAT,BMFLG, NOCAT, THIJl.IDATAl.NFILE.STATKY, 

CATNAM (60 ) , CLSS YM (60 ) .CON (60 ) , DET (60 ) , FLDESC , FLDINF (6 ) , KCLSNA (60) , 

NO CTCL(60),SUBCAT(60), NOCHAN, CHNVEC (30) 

C0MM0N/DISPL/CATFLG,CATNAM(61  ),CLSNAM(61  ),SUBNAM(61 ),SUBN0(60) .SUBCAT (60), 
CLSSUB (60 ) .NOMAP .T0TVT3 .N0SUB3 .PCFDKY .TSTKEY .TRNKEY .THRSKY .STATKY , 

EMPTRS .THRSVA . PLTKE Y , BMFLG , BMCOMB , BMFEAT .CDATE (2 ) , FLDSV2 , FI ELD2 , VERTX2 , 
FLDSV3,FIELD3,VERTX3,PCTID3,THRES(60).SYMMTX(66).HIGH(60).C0N(60),FLDKEY. 
NOFL  02 ,N0FL  03 , N0FET2 , FETVC2 (30 ) , N0SUB2 .NOTRFO .T0TVT2 .N0CLS2 , KATNO (60 ) , 
N0CAT.fi LTER .MAPFMT .OESKEY , OESUN I , OESOTH , CROP .ACROP , AOTHER . ATOTAL , S ITE (6 ) , 
ANALYS (5 ) .CAM (1 5 ) .CRPKEY .KEPPTS (60) .OOTKEY .OOTERR 

C0MM0N/00TVEC/TYPE,CATNAM(60),N0CAT,T0TVEC,FL0INF(6).PRTKEY,SIZE,LACIE 

COMMON/OVNBLK/OFOK.CAYMIN.FII.CCAY.IlO.IlOMEN.m.ICNT.N 

COMMON/FNTOUM/ITT, ICYCLE 

C0MM0N/FSL/CFAC,T0TMSR,SEPMSR,PRCKEY, CRIKEY, INCFET,INCVEC(3O),IC0UNT,SETWGT, 
EVALBF (1 00) .FETVC4 (30) ,N0FET4, VARSZ4 .CORBAS .0TAB4 .WGHSl 4, BESTVC (1 0) . 
0IVSIZ,STATKY,A0RES0,A0RESP,A0RESF,A0RSH1,A0RSH2 

COMMON/GLOBAL/HEAO(63),MAPTAP,OATAPE,SAVTAP,BMFILE,BMKEY,HISFIL,HISKEY, 

TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILE.ORUMAO.ORMWOS.PAGSIZ.OATFIL.STAFIL, 

ASAV.ASAVFL.NHSTUN.NHSTFI.SCTRUN.MAPFIL.OOTUNT.OOTFIL.NCHPAS.TRNSFL, 

BMTRFL.HISTFL.PCHUNT.CROUNT.PRTUNT.RANOIO 

COMMON/GRCBLK/MAXFET .NOFEAT , N0FET2 , FETVEC (30) . FETVC2 ( 30 ) , FLOINF (6 ) , INFMT , 
FILESV,NOHIST,HISVEC(30),NOFLO,FLOPTS,XSIZ,XLOW,XHGH,YSIZ 

COMMON/GTBK/NROR,NPRT,PRTKEY,VLB(6),GTROU,GTROF,GTWRU,GTWRF,GTNOF 

COMMON/HISTOR/HF 


COMMON/ IDST0R/IDDC250) 

COMMON/  IDWORD/  IDWORDO  000} 

COMMON/INFORM/NOCLS2,NOSUB2.NOFET2.VARSZ2,TOTVT2,NOFLD2,AVAR2,COVAR2,CLSID2, 
SUBN02,SUBDS2,FLDSV2.VERTX2,FETVC2(30).SUBVC2(75).SUBPTR(75).CLSVC2(60). 
KEPPTSC60).N0GRP,GRPNAMC60).GRPDEX(61 ),GRPCHK(61 ),GR0UPS(124) 

C0MM0N/IS0LNK/SUNANG(8).ISUNT.ISUNC.SMSTR.SMSTP,SMINC.LINSKP 

COMMON/LABS/NOCAT .CATNAM (60 ) .N0CL2, CLSNM2 (60) , N0CAT2, CATNM2 (60) , SUBRAY (120), 
PTR(60),CATPTR(250).CATD0T(500),D0TVEC(250),C0ND.MIX,PR0C.MAPKEY, 
D0TKEY.STATKY,SUNANG,T,NEARST.DIST,N0FEAT,FETVEC(30),0MAPUN,0MAPFI, 
0SAVTP,0STAFI,N0SUN,ANGLE(8),SIZE,T0TDT2,FLDINF(6),CLSSYM(62).STADRS, 

MEANAD .TABADR .MAPADR.SUNCOR (30) .ODOTUN .ODOTFI .MANSTA .MANDOT , DSPUNT , 

DSPF I L .DSPKE Y .PRNSTS , PRNDOT , FLDNAM. VERTEX (22 ) , NOVRT , NSUN .ANGLES  (8 ) . 
T0TDT3.FLDADR.VTXADR 

C0MM0N/LISTMM/NPGA(3.2).NAMPGA(209,3.2),LINPGA(209,3,2),SAMPGA(209,3,2), 

D0TLAB(209,4,2),VPGA(3),IPGA 

C0MM0N/MRGDAT/IM0PT.IS0PT,NUMFIL,IDATTP(6).IDATFL(6),N0FEAT.NFEAT(6), 

FETVEC(30,6),ISUN(8.6).SUNC0R(30),FLDINF(6,6),N0SAMP.N0LINE,NSS(6), 

NACR0S,NLINES(6),LINPTR(7),LINES(600),F0RMM 

C0MM0N/NDIM/NCLRCH,CLRVEC(30),MAXVEC,MAPKEY, CLASS, SUBCLS.FIELD.MEANSW, 

N0VEC,FLDINF(6),SIZE,T0TMNS,CNTR1,CNTR2,ID1,ID2,C0L0R1,C0L0R2.BUFLEN, 

I D3 , COLORS , NODUMP , I DATAl , TOTVEC 

COMMON/PASS/STOP, LNCAT,NMIN,kRN,STDMAX,DLMIN,SEP,MAP,SPTRIG,IRD,KPTS,NOPTS, 
PUNCH, ICHN,CHNTHS,ICHAIN(62).NWDS,IBEGIN,BEGIN1,BEGIN2, BEGINS, CLSNAM. 
NOFLD,IPT,TOTWRD,TOTPTS,NCLASS,NOCLS,TOTSUB,TOTFLD,TOTVRT,NOCL,NVRT, 
NXTCLS,N0FEAT,MAXCLS.FETVEC(30),SYMMTX(62),VARSIZ,STATKY,IS0KEY,MAPFMT, 
MAPKEY, SEQUEN(20),PERCEN,SIMERP,I0RDER, INUNIT, INFILE, INITM,PMIN,SUBVEC(62), 
NO SUB2,CHNVC(30), NOCHAN, ERCOMP,NOSEQ,MEANDO,MEANDU.SYMDO,SYMDU,ITRIGO, 
ITRIGU,D0FLAG,DUFLAG,D0DU.STD0TS(60),NSD0TS,SUNC0R(30),LLNCAT,DVERT(250,2), 
DRECT ( 60 , 2 ) , DVPNT ( 1 1 , 2 ) , I DCNT (2 ) , NDOU ( 2 ) .MXFETl , MAXPOP 

COMMON/ PASSA/NOFETl .FTVECl (30) 

C0MM0N/PASSB/N0CLS,N0SUB,N0FEAT,N0FLD,T0TVRT,FETVEC(30).FLDSV1,CLSID1 

C0MM0N/SCRACH/SCR1 (2000) ,SCR2(10500) 

COMMON/  SCHER/  RSCALE , XY5CLE  .CLRVEC  (30) , NCLRCH , CLRKEY  .LOG . FREQ  ,XMAX , YMAX , 

XMIN,YMIN,BCKGND,XHI,XL0,YL0,XSIZ,YHI,YSIZ,NBINS,SYMMTX(32),BMATRX(60), 
BVEC(30),NB.CHN, NOFEAT, SCALKY.MENADR.FLDADR.PNTADR.IDADR.NC.BMFEAT, 
BMC0MB,N0VEC.T0TMNS,SIZE,DRMID,DRMID1 .DRMCLR.DRMCRl .DRMTNS.DRMTNI , 
DRMCNT.DRMCTl ,DRMVEC,DRMVC1 .VECTR1 .DATAl ,NVEC,NOREAD,LREAD,DRMPTR, 

DRMPTl .FETVEC (1 6 ) , DRMPLT.CSCALE .NOSUB 


COMMON/STBASE/SUBSVl .SUBMNl .SUBVRl .SUBSDl .SUBCLl .SAVER! .HSTAL! .SPEC! .COVAR! . 
AVAR! . CLSID! . FLMEN! . FLVAR! . HFTAL! . FLDSV! 

COMMON/STCBLK/MAXFET .MAXCLS .MAXFLD. NOFEAT .NOFET2 .VARSI Z .NOSPEC .NOHI ST . 

SPCBAS  .IBL0CKC30)  .FETVECOO)  .FETVC2(30)  .HISVEC(30)  .NOFLD.NOCLS. 
FLDINF(6).FLDPTS.CLSPTS.XSIZ.XHGH.XLOW.YSIZ 

COMMON/TAPERD/IUNIT.IFRST.FSCAN.SAMEND.SAMINC. READY. NSCAN.LINC.ID(200). 
DSL.LBUF(30) . JREC(30) . IBHE (30) .NBUFS.FILENO.LINEND.LININC.NSAMP. 
NOCHAN. FORMT 

COMMON/TR/TRNS! ( 2 56 ) . TRNS2 ( 26 ) .TRNS3 ( 26 ) ,TY ( ! ! , ! 9 ) 
COMMON/TRBLCK/OUTFMT.NOFEAT.FLDINF(6).FETVEC(30) 

COMMON/WRTAP/ ICOUNT .FORMT .UNIT.VARBL (600) , IREMD 
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HIST  PROCESSOR 


FILP!  HIST 


C 

C 

i\ 

Cl 

c 

c 

c 

Cl 

Cl 

81. 

Cl- 

8‘ 

C 


SUflPOUTlNE  HlST(«RHAY»TOP) 
IMPLICIT  INTEGER  (F-T) 
DIMENSION  ARRAY (1) 

//HIST 


CALL.  CALL  HIST(AHHAY»T0P» 

REDUIRES.  NO  COMMON  «LOCKS 
ROUTINES  SETUPS 
MISTGH 

PURPOSE.  COORDINATES  THE  LOGICAL  STEPS  FOR  HISTOGRAMMINO 
DATA 

returns.  NONE 


CALL  SETUPS  TO  READ  IN  CONTROL  CAROS 
CALL  SETUP5(FILHS.FL0TL.T0TTL.T0P> 

CALL  HISTGM( ARRAY (FILMS) . ARRAY (FLOTL ) .ARRAY ( TOTTL) ) 

RETURN 

FNO 


HISOOOlO 

HIS0002P 

HlSOOOSO 

HisopOAO 

HISOOOSO 

HIS00060 

HlsnoOTO 

-Hisooono 

•HIS00090 

HISOOlOO 

HlSOOllO 

HIS00120 

M1S00130 

HIS00140 

HISOOISO 

MlSOOiGO 

HfSOOlTO 

MIS00180 

Hisooiso 

Hfsooaoo 

•H1S00210 

•HI500220 

HIS00230 

MIS00240 

HIS002S0 

HIS00260 

HIS00270 

HIS002R0 

M1S00290 

H1S00300 

HIS00310 


FILFi  SF.TUP5 


Cl 


C 

C 


CSF.NO 

r. 


SUnunuTINF  SETUP«i«F!l,HSfFLOTLtTOTTLtTOP) 

IM»Lirit  1NTE(?FP(A-?> 

PU»POSF  — PEAOS  THE  CONTROL  CARDS  FOR  HIST  PROCESSOR 

INCLUOF  COMWKSfLIST 
INCUJOF  C0MqK4»LlST 
INCUIOE  C0HuK6,LIST 

COMMON  /6RCHLK/MA*FET.NOFFAT.NOFET?tFETVFC(30). 

• FETVCZOO)  ,ri.DINF(6»  tlNFMT»F|LESV»NOHlST» 

• hTsVECOO)  .NOFLOt  FLDPTS 

•♦F«:i7t*l.OWf  XHGH.VSIZ 

niMFN«i!ON  HFOl  (1*5)  »H£n2n«i)  *nATE(3)  fCOMENTdS) 

Foui Valence  (hfoh i ) .meao(a) ) . (oatf n » tHEAn<??) ) . 

2 1 ) .HEAOnO)  » t tCOH£NT(  U tHEA0(4rt)  ) 

COMMON/GLOBAL/HFAOCft.l)  »MAPTAP.DATAPE»SAVTaP.HMFILE«BMKEY» 

• HlSFIL»HISKEY.TQFORH.fWIPTP.ERPKfV*MAPUNT»NOFlLE. 

• nw(iMAO»nRHw|)S.PAGSIZ»OATFIL*STAFlL*ASAVtASAVFL 

• ,NM«iTUN.N‘^STFI,SCTRl.)N»HAPFlL 

• ,OOTUNT.OnTFlL.NCHPAStTPNSFL.8MTRFL«HlSTFL*PCHUNTf 
CROUNTtPHTUNTtRANOIO 


C 

C 


c 

c 

c 


oi*<en<;ton 

ni‘'FN‘;lON 
nl  HENS I ON 


Cfl'^DCft?)  ,ACA«0(20» 


F'MiVEC(?> 

INVFCT(9)  ,NUHVEC(30)  tlPTVECOO)  .IPTCZ)  tCHAR(2) 


NUMVCl (30) 


r 

c 

c 


c 

c 

c 


DATA  INVfcCT  /'CHAN't  • HEDl * » 'HE02* * 'COMH* , 'DATE* • 

• . •*E''in»  * ‘SIZE*  t •DATA*/ 

OATA  FOIJVFC/I  • • = 

OATA  MLANK/'  »/«ChaR/1 * ‘s'/tEOUAL/'s'/i IBCO/* 1 •/ 
data  ur<C0/*i"/  . LRCD/'L'/  * HBCD/'H'/ 
data  YRCD/'Y*/,  FPCD/*F'/  . XBCD/*Xi/ 

UJFMTs? 

XSIZ  = 101 
YSIZ  = IS 
YHSH  = ?5S 
XL'VW  s 0 
MOFFAT  » 0 
NOMIBT  a 0 
CALL  TnATE(OATE) 

WRITF (A»630) 

SETUP  REREAD  riUFFFR 

CALL  PFREAn(30.PO) 

NOW  PUT  TMF  next  CARO  IN  THE  BUFFER 
10  PF«D(;'l  tl*^)  ( Af.AwO  ( I ) t 1 = 1 *?0) 

15  FOPHAr (POAA) 

WHITE (30. IS) { AC AWD(I) .1=1.20) 

PFwitji)  30 

HEAD ( xn.AHO) CODF.CARD 
oFvlNO  30 

wPTTF(A.S50)  CODE. CARD 
COL  = 0 
no  20  1 = 1. P 

IF (CODE .EO. TMVFCT ( I ) ) GO  TO  ( 30.A0.50.60.70. 

• OO.  ISO.  loo.  WO)  ) . I 
PO  roMTlNUF 

wRITF(a,4W0)  code. CARO 
fiO  TO  10 

CHANNEL  CARO 

30  J - NYTC'tP  (CARD. COL) 

IF  (J  .E).  OLAMK)  GO  TO  10 
COI  = COL  - 1 

^■0FFAT  = NU'*BFi?(caRO.COL.NUHVEC.NOEEaT) 

CAI I SOwT(NOEFftT.IPT.NUMVEC.IPTVEC) 

K A 3 IRT ( 1 ) 

no  3S  1=  l.N(-iFEAT 
FFTVEC(I)  = NllHVLC(KA) 

3=1  KA  = IHTVtC(^A) 

f-0  TO  10 

HEDl  CARD 


SETOOOIO 

SET00020 

SET00030 

SET00040 

SET00050 

SET00060 

SET00070 

SETOnOBO 

SET00090 

SETOOlOO 

SETOOllO 

SET00120 

SET00130 

SET00140 

SET00150 

SETCOIBO 

SET00170 

SETOOIBO 

SET00190 

SFT00200 

Sf T00210 

SET00220 

SFT00230 

St  T00240 

SFT002S0 

SET00260 

St  T00270 

SET00280 

SET002PO 

SET00300 

SETOO'UO 

SETO0320 

SFTO0330 

SET00340 

SET003S0 

SETO03S0 

SET00370 

SETO03B0 

SET00390 

Sf T00400 

SET00410 

SFT00420 

SET00430 

SKT00440 

5ET004SO 

SET  00460 

SET00470 

SET00450 

SFT004RO 

SFTOOSOO 

SFT00510 

SETO0S20 

SFTOOS30 

5ET00S40 

SETOOnSO 

SET00S60 

SFTC0S70 

SETOOSHO 

SETOOSVO 

St  TU06O0 

SEToonlO 

SET00620 

SFTO0630 

SET00640 

SFTOOOSO 

SE I 00660 

St  T00670 

SETOOnHO 

SF  T 006P0 

SFT00700 

SFT00710 

SETOO  t2Q 

SE  T 00 7 30 

SE  TOO/40 

St  T007S0 

SE.  TOO  /NO 

SETOO  / 70 

SF 1 on /HO 

SFTOO7P0 


V.  ' 


n,rtrt  nnr»  r>r>r> 


FILFJ  SETUPS 


PEAOOO.SOOJMEOI 
pEWINO  30 
TO  10 

HEO?  CARD 

OE*P(30.500)HE02 
oNino  30 
GO  TO  10 

COMMENT  CARO 

»5'(D(30.500)  COMENT 

pEwino  10 

GO  TO  10 

DATE  CAPO 

PEAOdO.SlO)  DATE 
ppwiNn  10 
GO  to  10 

nlSPLAY  CAPO 

J s NXTCHP  (CAROfCOU 

IF  (J  .fd.  uLANK)  GO  TO  10 

cni.  » roL  - 1 . . 

NOHIST  = NUMHER(CAHI)»C0L»NUMVC1*N0H1ST) 

GO  TO  in 


cou 

COl.  ,CHAH) 

F(iUAL)  GO  TO  120 
COL  *NUHVEC.O) 

XHGH  = NUMVEC(l) 
GO  TO  97 
GO  TO  120 


site  capo 

07  rOL  = COL  - 1 

mo  .1  = MXTCh;^  (CAPO. COL) 

IF  (J  01.ANK)  GO  TO  10 

IF  (J  ,FQ.  y'Cn)  GO  TO  130 
IF  (J  .FO.  <WCO)  GO  TO  UO 
GO  TO  1 />0 

110  M = FI^'()12(CAPO, COL. CHAR) 

IF  (CHA»'((M)  ,t.F.  EOOAL)  60  TO  120 
M = N'.imhLw  (CAFP.COL.NUMVEC.  0) 

YSI7  = r-'UMVFL'dl 
r-0  TO  0 7 

WiO  ,1  s NXTCtnR  (OAWO.COL) 

M = FINI)12(CawD. COL. CHAR) 

IF  (rHAR(M)  ,liF,  FOUAL)  GO  TO  120 
M s NI)M‘(KR  (CARO. COL  *NURVEC.  0) 

IF  (J  .Hi.  ^G.C0)  XHGH  = NUMVEC(l) 

IF  (J  .Ff!.  Hi'Cm  GO  TO  97 
IF  (J  .f'F.  I RCO)  GO  TO  120 
XLOW  = NiJ'AVFC(l) 

GO  TO  or 

OATAFILE  positioning  CARO 

1701  MsMXTCwP (CARD. COL ) 

IF(iA.t0.hLA"(O  60  ro  10 
IF (M.EO.O-  CD)  GO  TO  1702 
IF (M.FO.FmGD)  go  to  1703 

I 7 0S  JRITF  (G.  1 70  ■. ) 

170A  FORMAT (•  FRROR  on  data  FILE  CAPO  •) 
GO  TO  1 A 

170?  J=FIM)1 ? (CARO. COL .EOUVEC) 

IF  ( ) GO  Ti)  1 MS 
m=nuppfw (CARD. COL .DA  TAPE* ZERO) 
COL=COL-l 
GO  TO  1 701 

17  01  IsFINDl  ?(CARn.rOL.E'jUVEC) 

IF(J.FO.-l)  GU  ro  17'>S 

FII  NOiNMMRFR (CARO  ♦ COL » 0 ATF IL . F 1 LNO) 

nATFlLrOAlL IL-1 

COL=COL-l 

GO  TO  1701 


ISO  rONTlN'IF 

IF (NOHISI.KO.O)  GO  TO  1 


SETOOaOO 

SET00610 

SET00«?0 

umtn 

SETOOaSO 

SETooaao 

SETQOaTO 
SETOoaao 
SETQOH90 
SET00900 
SET00910 
SET00920 
SET00930 
SET00940 
Stt009SO 
SEt00960 
SET00970 
SEToooao 
Sr,T00990 
SETOIOOO 
SETOIOIO 
SET01020 
SFT01030 
SETOlOAO 
SETOIOSO 
SFT01060 
SFTOI070 
SFTOIOBO 
SET01090 
5FT01100 
SFTOlllO 
SET0I120 
SETOl 130 
SET01140 
SETOl 150 
SFTOl 160 
SET01170 

SETOl  mo 

SETOl 190 
5ET01200 
SET012I0 
SET01220 
SET0i230 
5FT01240 
SET 01 250 
SET01260 
SET01270 
SFT012P0 
5ET01290 
SET01300 
SET01310 
SF TO  1320 
SET01330 
SET01340 
SET01350 
SFT01360 
SET01370 
SET013M0 
SL  TOl 3P0 
SET01400 
SFT01410 
SFT01420 
SF TO  14 30 
SFT01440 
St-  T014S0 
SFI01460 
SF  T 0 1 4 7 0 
SL  T014A0 
SET  01490 
StTOlSOO 
SF TO  IS  10 
St  I01S20 

Sf  Tomio 
St  TO  1540 
St  T01550 
St  101560 
ShT01S70 
SET015H0 


Jl 


o.">r»  nnn  r>nn 


Ft».€!  SETUPS 


IS  OISPL/kY  • SUBSET  OF  CHANNEL  CARO 


J55 


lAO 


l«S 

1 


?l!i 


170 


J«ltNOMlST 


[Ml  X - - - 

JSS  lal.NOFCAT 
IF  Inumvckji  .eo.  FETveccm 
CONTINUE 
WPITFIStSSO)  NUMVCUJ) 

N^^VflUI  ■ 0 

Sail  *so^T  (NomsTt  ipt.numvci  » irtveci 

K*  B iPTin 

no  ifts  Ibi.nohist 

HlSVFCtl)  * NIIHVCI  «KA) 

KA  s IPTVEC(KA) 

CONTINUE 

CHfCXiNG  XMIGH  AND  XLOW 

.6E.  100) 


00  TO  160 


1#  *■* 

610 

6 \Q 

6S0 

660 


IFnXHGH  - XLOW) 

KUOw  c xHGh  - 100 
IF  (XLOW  .LT.  0)  XHGH 

IF  (XLOW  .LT.  0)  XLOW 

WMITF  (6.570)  XH(;h,XLOW 
CONTINUE 

RASES  FOR  ARRAY 


60  TO  170 


If  0 
0 


?ftO 

6RO 


<.«0 
46ft 
son 
M 0 
S7(' 


SETOIS^O 
SETOlt  30 
§|TO 
SETO 
SETO 
StTO 
SETO 
SETO, 
SFIolNTO 
SETOlORO 
SET016R0 
SF.T01700 
SETOlMO 
SET01720 
SET01730 
SET01740 
Sf,T017S0 
SET01760 
SET01770 
SET01780 
SETO 1790 
SETOIROO 
SETOIMIO 
SETC1620 
SET0ift,30 
SET0|ri40 
SETOlrtSO 
SET01H60 
StT0lH70 
SET016R0 
SET01690 
SFTOl‘500 
StTOlNlO 

RESET  NO  ! CMANNEIS  I J 8E  DISPLAYED  AND  RECALCULATE  ADDRESS  TOTTLStT0|9?0 

Sf T0l“40 
S) TOIVSO 
SFTOls-.O 
SE  T01970 
Sf TOlNrtO 

Set  01 990 

SFTO?000 
SETOPOlO 
SETOPOPO 
SETfiPO  10 
PLOTTED.  •/Sf,T02040 
SFTOPOSO 


Fll  MS 
FLOTI. 
TOTTL 
TDTPTS 
IF(T0TPTS 


NOHSTl  5 
NOHIST  : 
TOTTl  = 


N0FE4T* 
NOMTS  i » 


i *'  t 


♦ FILMS 
xs'  ' ♦ FLDTL 
« i::T7  ♦ TOTTL  - 
TOP’,  RETURN 


1 


;0 


1ST 
0?  - 
11ST«XSI 

* 


nohst  = NOHisr  ♦ 1 
zero  out  Channels  that 


(FLOTL-l)  ) / (2*XSIZ) 
Z ♦ FLDTL 


are  not  to  be  PLOTTED 


no  ?Po  I snohst .NOHSTl 

HIS'/FC  ( l ) »^  0 

FORMA M/ ^ t \oO  MANY  CHANNELS  A>*E  BE ING  •HISTO6RAMME0 
• • NO.  OF  CHANNELS  PLOT  TED  WAS  RESET  TO*. IS) 

Rf  TURN 

FOR*  AT  (i34.6*.6.'*Al)  „ ... 

F0°H4T  i > if^vAi  in  Card  --  irnor£&*/T5.a*«6X.62ai) 
FORMAT ( 1 OX , 1SA4) 

FOR'if’!lOX.  3A4) 

FORMAf(*  XHIGh  - XLOW  WAS  less 
?X.*  00  XLOW  WAS  HE:SET  10  *. 


ANO 


F0R'*A  I (5x  . 64. 6X  .6?A  1 ) 

660  FOa'  -rM  C«A*'  el  •»I2«’  JS  no 

*H4N  r I C6  • ) 

6’XO  FO‘’*AT(//-  INPUT  summary*) 
i?o  wf>ti»  ,6.6**o)  r-iriE.CAPb 
.-40  forma,  !/  lX.A  . .6X,6,;A1/  * P,AO 
r-0  TO  • <• 

END 


THAN 

i3) 


SETO2060 
Sf  T02070 
SET02080 
SET0P090 
5ET021  f/0 

100.  XHIGH  WAS  RESET  TO  *.13.  SET02110 

St  T02120 
SET02130 

A SUBSET  OF  THE  CHANNELS  GIVEN  ON  CSETOPUO 

SETOPISO 
SfcTO?lhO 
SETO?) 70 
SETOPIAO 
SET0P190 
SETOPPOO 


SUPERVISOR  control  CARD*/) 


FILft  «;o»T 


Cf' 

^ ■ 

t 

r. 

c 

c 

c 

c 

c 

Cl 

r! 

r. 

Cl 

cf 

c 

c 

Cl 

cr 

ci< 

c 


SU«»OUT  I NF  <;0«T  < U ♦ I *>T  . NUMVt'C  ♦ 1 PT  Vf.  C ) 


»CI 


CALL 


f.O»TnA»IPT«NUMVFCiIPTVFO  ^ 

U --  NO,  OF  tLEMFNTS  TO  Bt  SOtlTCO  IN  aSC£N  Cl 
01  NO  OMDtP 

IPT  — CONTAINS  PFG.  ANO  ENDING  POINTED  FOR 
IPTVk'C  AHHAV 

NUMVIC  — AOHdY  CONTAINING  ELEMENTS  TO  BE  SORTED 
IPTVeC  --  AMHAY  CONTAINING  POINTERS  FOP  NUMVFC  Cl 

EXAMPLE » 


IPT 

IPT 


« 2 

A 


smallest  no,  » NUMVFC(IPT(1>) 

NEXT  NO,  ■ NUMYeCdPTVECIlPTim 

last  NO,  **l*NUMVEC(IPTVECnPT<?>) 


*CI 


OI'^ENSION  IPTVfCI  30  ) , IP*  ( ?)  .NUMVEC  I 30  ) 


ICT  5 

•JO -1ST  Is  IS 
PO  AO 
tr;T 


I s l«IA 


a Ic;T  ♦ 1 

IF  ( ICT  ,(>T,  11 

IMTM)  r 1 

!PT<?)  « 1 

IF  < ICT  ,1-C,  IPTIl) 
1 n K4  s IMT ( I I 

sf-  t mT(?) 


GO  TO  10 


) GO  TO  AO 


TF 

(WMi-vt-  cm 

.FP. 

01  nomsti 

a I.OhSTI 

- 

IT 

(*:>;«vFr  ( I ) 

,FU. 

0)  GO  TO 

AO 

IF 

(Nu*'  <:  n ) 

,LT  , 

NIJMVF.C  (K  A)  ) 

OO 

TO 

30 

IF 

(N'i'^VhC  ( » 1 

• I’L  , 

NU'^Vr.C  (AM)  ) 

uO 

TO 

40 

KO 

s Hi 

KA  a Ii'TV^CIRA) 

IF  (NM-vLCcirn  .i.t, 

r-n  To  ?0 

?p  iPTvFcncri  = iPT(i) 

IPT ( 1 1 S K T 

MM  S IPK?) 

CO  TO  AO 

40  IPT(?)  s TCT 

iptvicc<m)  = icr 

CO  To  AH 

■^0  IPTVf  C ( ICT)  S <A 
IPTvfC(^H)  = ICT 
AO  rONTlNMr 

lA  r fOtiSTl 
P("  TUPN 
KMO 


NO'^VECIKA)  loO  TO  so 


<D3 


7 . GRAYMAP  PROCESSOR 


riLKi  6RAVMP 


SUBROUTINE  6R»YMP(AHRAY»T0P) 

IHPUCIT  INTf6ERU-2» 

niHENSION  ARRAY(TOP) tBINLCV(30*16) 

PIRENSION  SYMBOL (16*2) 

INfLUOr  COrt»K3,LlST 
INCLUOE  COMURi.LIST 
INCLUDE  COMrtK6,LIST 

common  /GMCHUA/HAXEET,N0EE*T*N0FET2«EETVEC(30) « 


•.XS!7.XI0'-.XM6H 


F£TVC?(30) .FL01NF(6»  tiNFMT.FILESV.NOHlSTf 
HlSvCc  < 301 fNOFLO*  FLOPTS 

♦ YSIZ 


niMfNSION  MFD  1(15)  .ME02(15)  tOATEO)  .COMENTtlS) 

EQUIVALENCE  (HEOn  I ) t HE  AO  (A)  > • (DATE  ( 1)  *HE  AO  ( 2?) ) t 
i (HED2(  n tHEAO(30) ) t (COMENTU)  ♦HEA0(A8»  1 

C0MM0N/GL09aL/mEAIH63) .maptap*oatape.savtap,mmfile *phkey. 


(MEOn  1 ) t'MEAOC 
(HED2( n tHEAOl 


MlSEiLtHlSREY*TRF(3HMtERlPTP,E»PKEY»MAPUNTfNOFILE* 
nRuMft0tnHMw0S.HA6SlZ»nATFILf5TAF|LtASAV»ASAVFL 
.NhsTUN.NHSTFI »SCTtn)N*MAPF IL 

,f)0TUUT,t)0TFlL.NCHPAStTRNSFL«8MTPFL*HlSTFL»PCMUNT# 

CRDUN'T.P-(rUNT«KANOIO 

common  /mISTOR/HF 

CALI  SFTUP5I ARRAY. HINCNT.R INLEV «NUM81N.SYMB0L»SYMCNTtSYM0lM) 

IF  I (ni‘iCNT.KO.1 ) .OH.  (HlSKEY.EO.  1)  ) 60  TO  1 

ril,HS=:) 

FLOTL  = ‘<00O 
TOTTI  :=<5000 
HFsl 

CALL  MlsTi'.M(  AhRAYIT  ILHSI  .array  (FLDTL)  .ARPAY(TOTTL)  ) , 

CALL  S^  TuRM  ARRAY .H INCNT.RINl  E V . UuMB I N. SyMROL » SYMCNT , SYMO IM) 
CALL  PICT  IftHWAY.MINLtV.NUMHIN.SYHBOL.SYMCNT.SYMOIM) 

HFsO 

PFTURU 

END 


onoonooooonnonooono 


FILE:  HEADNG 


SUBHOUTINE  HFAONG(TYPE*FETNUM,PINtEV*NUMBlN,FLOINP» 

* symbol. NSAMP,FETtSYMOIM«TCOL) 

IMPLICIT  INTEr,ER(A-2) 

CALL..  CALL  HEADNGdYPETFiTNUMT” 

APGS..  Type  - refers  to  column  heading 

FETNUM  -refers  TO  LOCATION  OF  FEATURE  IN  FETVC2  ARRAY 


REQUIRES.  COMMONS  /INFORM/ 
/GLOBAL/ 


/INFORS/ 

/HELP/ 


PURPOSE..  PRINTS  OUT  HEADING  INFORMATION 
RETURNS  NONE 


INCLUDE  COMQK3.LIST 
INCLUDE  COMahA.LIST 
INCLUDE  COMJKS.LIST 

common  /GRCHLK/MAXFET. NOFEAT. NOFET2.FETVFCI30) . 

» FETVC2(30) ,FL0INF(6) .iNFMf .FILESV.NOHIST. 

* HISVECOO)  .NOFLD.  FLDPTS 

*,XSIZ.XL0>..XHGH,YSI2 

DIMENSION  hED) (15) »HE02(15) .0ATE<3) .COMENT(IS) 
equivalence  (HEDl (I) .HEA0(4) ) , (DATE ( 1 ) .HEAD(22) ) . 

2 {HED2(1)  .hEADOO)  ) . (COf-ENT  ( 1 ) .HEAD  < Aft)  ) 

COMMON/GLOBAL/HE AD (S3) . MART AP, DAT  APE. SAVTAP.8MFILE.8MKEY. 

misfil.hiskey.treorm.eriptp.erpkey.mapunt.nofile. 

DRUMiD.nMM.OS.MAGSIZ.OATFIL.STAFIL.ASAV. ASAVFL 

.nhstun.nhstfi .sctpun.mapfil 

,D0TU',T.D0TEIL.NCUPAS.TRNSFL»8MTRFL*HISTFL.PCHUNT» 
CRDUNT.PhTUNT.RANOIO 


.SAMSTR) , 
.SAMINC) 


C5END 

DIMENSION  symbol (16,2) .EET(l) ,FLUINP(7) 
dimension  ICOLd.llO)  ,HINLEV(30,16) 
equivalence  (FLDiNE'd  ) .LINSTR)  , (ELD  INF  (2)  .LINEnO)  . 

* (FLDINF (3) .LINING) , (FLOINE(A)  

» (FLDINK(S) .SAMEND) . (FLDINF(6> 

tf(typf.eq.2)  go  to  no 

IF(TrOL.EQ.l)  GO  TO  120 
J=FFTNUM 
103  FIC5T=n 

WRITE (6. ini ) FIRST. (8INLEV ( J.MA) »MA=1 .NUMBIN) 
mi  FnPMAT(//12.m(3X,I3)  ) 

no  m2  iz  = i.A 

WRITF (6, lOA ) ( (SYMBOL (Ma. 1 ) .SYMBOL (M A. 1 ) .SYMBOL (MA. 1 ) .SYMBOL (MA, 1 ) 
« SYMBOI.  (MA,  1 ) .SYMBOL  (M  A.  1 ) ) , MA  = 1 , NUMB  IN) 
lOA  FORMAT (px .R^Al  ! 

IF  (SYMDIM.EO. 1 ) 60  TO  102 

WRITF  (6,ms)  ( («YMB0L(MA,2)  . SYMBOL  ( M A . 2)  .SYMBOL  (MA , 2 ) .SYMBOL  (MA, 2) 

* SYMBOL (MA,?)  .SYMBOL (MA, 2) ) , MA= 1 .NUMB  IN) 
ms  FORMAT  ( IH.  , 1 X ,Q6A1  ) 

m?  CONTINUE 
i?n  ruuriuuE 

CAI.L  SFTMRO(66.0,h6) 

C CALCULATE  AND  PRTNT  SAMPLE  NUMBERS 
.10  = 0 

SS:=FI.  DlfiP  ( 4) 

SE  = FLD1.;P  (S) 

00  106  mss. SE. SAMINC 
JO  = ,JO+1 

TCDL(i,j(i):n/mo 
TCOL(2..J0)=^MO()(l,m0)/10 
IC0L(3.JG) =M00( I. 10) 

ms  continue 

no  IF  (TYPF.E0.2)  wRITE(6,ni) 
no  107  mi. 3 

107  write  (ft,  IIIH)  (ICOL(I.J)  .J=1.NSAMP) 

m«  format (1  ox.  1 1011) 

WWT1F (6. 1 n ) 
in  F0RMAT(1H(^) 

IF (TvPF.EO.2)  call  SETMRG(ftft.4.62) 

RFTUKN 

END 


HEA03010 
HEA00020 
HEA00030 
HEA00040 
-HEA00050 
HFAOOOftO 
HEA00070 
HEA00080 
HEA00090 
HEAOOlOO 
HEAOOllO 
HEA00120 
Ht A00130 
HEA00140 
HEA00150 
HEA00160 
HEA00170 
-HEA00180 
HEAOOmO 
HEA00200 
HE AO 02 10 
HEA00220 


COMOOOlO 
COM00020 
COM00030 
COMOOOlO 
COM00020 
COM00030 
COM00040 
COM00050 
COM00060 
HEA00240 
HEA002S0 
HEA00260 
HEA00270 
HEA00280 
HF.A00290 
HEA00300 
HFA00310 
HEA00320 
HEA00330 
HEA00340 
HEA003S0 
HEA00360 
.HEA00370 
HEA00380 
HEA00390 
HE  A00400 
.HEA00410 
HEA00420 
HEA00430 
HE A00440 
HEA00450 
HE A00460 
HFA00470 
he:aoo4«o 
HFA004R0 
HE AOOSOO 
HEAOOSIO 
HEA00520 
HE A00S30 
HE A00S40 
HFA005S0 
HEAOOSftO 
me:a00S70 
HEA00S80 
HEAOOSRO 
HE AOObOO 
HE A0061 0 
HE A00620 
HE  A00630 
HE  AOOhAO 
HEA006S0 


ri,-)  r>  no  nooonononnnoononnn 


FILF:  PICT 


TEND 


«;URP0U1 INE  PICT (8UF.BINLEV.NUMfaIN,SYMB0L»SYMCNT»SYM0IH) 
IMPLICIT  INTFGEP(A-Z» 

CALL..  CALL  PICTUOATA) 

ARGS..  lOATA  - SCANNEH  DATA 

ROUTINES  HEADNG  TAPHOR  FLDINF  LINERt)  LAREAO 
PURPOSE.  PICTORIALLY  DISPLAYS  FEATURES  REQUESTED 
RETURNS  NONE 


TNCLUDE  CORRKft.LIST 
INCLUDE  C0X!:.K3.LIST 
INCLUDE  C0M.-JK4.L  1ST 

COMMON  /GRCBLK/MAXFET.NOFEAT.NOFET2.FETVEC (30)  . 

* FETVC?(30) .FL0INF(6) » INFMT.FILESV.NOHIST. 

• HISVFCOO)  .NOFLO.  FLDPTS 

«.XSI7.XL  nw.XHRH, YSIZ 

DIMfmsion  hEDI  (IS)  ,HE02(1S) .DaTE(3) .COMENT(IS) 

EQUIVALENCE  (HEDI ( 1 ) .HEAD ( 4 ) ) , (DATE ( 1 ) . HE AO ( 22)) . 

2 (HED?( 1 ) ,HEAO(3n) ) . (COMENT(l) .HEAO(40)) 

COMMON/C’LOliAL/HEAn  (63)  . M ART  AP , DAT  APE  . S A VT  AP,  HMF I LE . 8MKE  Y . 

HISF IL.HlSKEY.TREOkM.ERIPTP.EPPKEY.MAPUNT.NOFlLF. 
DRU'^AU.DRMwDS.PAGSIZtOATFILtSTAFILtASAV.ASAVFL 
.NHSTMN  .r-jHSTP  I , SC  TkUN.M  APRIL 

.nOTUtJT  .OOTEIl,  .NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

CRDUNT .PHTUNT.KANDIO 


FOUIVAI.EN'CE 


dimension 

dimension 

niMFNSION 

DIMENSION 


(FLDINF ( 1 ) .LINSTP)  , 
(FLO  IMF (3) .LINING ) . 
(FLO)IIF  (S)  .S AMEND)  » 

UNLRVO0.16) 


(FLDINF  (?)  , I, INEND)  « 
(ELOINF (4) .SAMSTW) . 
(KLOINF (6) .SAMINC) 


PICOOOlO 

PIC00020 

PIC00030 

P1C00040 

■PIC00050 

PIC00060 

PIC00070 

PICOOOflO 

PIC00090 

PICOOlOO 

PICOOllO 

PIC00120 

PIC00130 

PIC00140 

PIC00I50 

PIC00160 

-PIC00170 

PIC00180 

PICOOIRO 

P1C00200 

PIC00210 

PIC00220 

PIC00230 

PIC00240 

PIC00250 

PIC00260 

P1C00270 

PIC00280 

PIC00290 

PIC00300 

PIC00310 

PIC00320 

PIC00330 

PIC00340 

PIC00350 

PIC00360 

PIC00370 

PIC00380 

PIC00390 

PIC00400 

P1C00410 


DATA 

data 


PI  ANK/»  •/ 

OPAH/I  ( '/.CPAR/* ) '/.COMMA/'  . '/ 


LCHAP (?,?S6) .LIM(1 10) . I data (12000) .BUF( 110.20) . JSTAT (20) PIC00420 
SYMOOl.  ( 16,2)  .EET  ( 1 ) .ELDINP(6)  PIC004  30 

VEPTCS(2.11).FL(fl)  PIC00440 

PIC004S0 
PIC00460 
PIC00470 
PIC004S0 

REAP  HEADER  HECORD  ON  DATA  TAPE  PIC004RO 

CALL  TAMnOW  (DATAPf- .DATE  ID  PICOOSOO 

C READ  EIEI.D  HEEINITION  CARDS  PlCOOblO 

20  PUNNO-I  Ai-Ein(El  Onam.VERTCS.FLOINE.NC)  PIC00520 

TE (RUNNU.iK.n)  GO  TO  1 PIC0OS3O 

C CHECK  TO  SFE  IE  INEORMATION  WILL  FIT  ON  DRUM  PIC00B4O 

NrmES=20  PIC005SO 

PTS=(EI  ')1NF(S)-EL0INE(4)  ) /ELD  I ME  ( 6)  ♦ 1 PIC00560 

SPTS=PTS  PIC00S7O 

L INtS-.-.  (n.Hp:E(?)  -FLUINE  ( 1 ) ) /FL  D I NF  ( 3 ) ♦ 1 PICOOSPO 

NOFFTa  =')())■  E T 2 P1C0O5P0 

27  MmiFSZ=PIS»'jOEET4  PIC00600 

TSAMPrI  [NES*NBUFS7  PIC00610 

!E(TSAH2.LE.nPM^DS)  GO  TO  26  PIC00620 

C REDUCE  NO.  OF  channels  HY  ONt. CHECK  TO  SEE  IE  FIELD  WILL  FIT  PIC00630 

MDFET4-;:0EtT4-l  PIC00640 

GO  TO  2/  P1C006S0 

P6  IE(N0EFT2.NF.NnFFT4)  WRITE  (6. 2M)  N0EFT4  PIC00660 

23  EOOMaTC  Thf  no.  of  channels  FOR  THIS  FIELD  HAS  BEEN  REDUCED  TO'.  PIC00670 
«I3.'  sn  ALL  THF  INEOwMATION  will  FIT  ON  DRUM)'/'  MAKE  ANOTHER  RUMPICOOGfiO 
*TO  GRAY’'AP  OTEiFP  CHANNELS')  PICOOKRO 

CALL  FI  OF 'iT(FLDlNE.EKIVC2.NOEET4)  PIC00700 

ADPE5=nRU'An  PIC00710 

no  (-1. lines  PIC00720 

CALL  I.  U'ENIH  HurA.ENi)TAP)  PIC00730 

TF ( ENDTaP .uE . 0)  GO  TO  iO  PIC00740 

CAI  L PnhFTE  (AORf  S.ltiArA.NHllESZ.LSTAT)  P1C0O7SO 

31  IE  aSTAT.l  '..  1 ) GO  TO  31  PIC00760 

ADPES  = A''mHS*r:E'i;FS/  PIC00  7/0 

IF  ( AriREN.EE  ,nRUM,'.|i*DR.iwOS)  GO  TO  29  PlCOO  /rtO 

WRTTF(6,3i)  PIC00790 


FILF 


PICT 


33 


?<i 

30 


300 


NO. 

INC 


OF*/ 

INC 


VERTICES 


C SET 


1 n 
q 


F0RMAT<*  field  too  LARGEfTERHlNATINGM 
CALL  CMERR 
CONTINilF 
CONTINUE 

FLniNPd  ) sFLDTNFn  ) 

FLniNH(?)=FiniNF(?) 

FLniNP(3)=ELniNF(3) 

F^niMU(^) =FL01NF(6) 

c FOR  fach'feature 

00  * J=1 .NOFETA 
PTS=SPTS 

NAnRFS=DHilMAD*  ( J-1I*SPTS 
FL0INP(4) =0 
FLriINP(S)=0 
FFTd  )=F£TVC2(J) 

WRITE  (<S,HEAD) 
mm=NC-1 

FORMftT(T?A, ‘SAMPLE  LINE 
“PX.THltJNfcL  fieldname 
«LF.LINF) • 

*/3X.  I3«7X.AA«7X.1A,2X, IA.7X.I2t7X.5<Al.I4.AltI4.Alt2X)/ 
*T5l .S ( A1 . 14. Ai»I*» A1 .2X) ) 
wRITF(6.?00)  FEKD.FLONAM  .SAMINC.LININC.MM, 

•( (OPAPfVEWTCS  «1»NM) »C0MMA»VERTCS(2»NM) .CPAR) »NMs1,MM) 
TCOL  =0 

UP  VALUF-SrMROL  TAPLE 
no  9 >IO=1,SVMOIM 
r2=HlNI.FV(J.l  > ♦! 

no  rt  n=i,i2 

LCHAMJD.13)  =SYMS0L(1*JD> 
no  10  J1=2,NUmPIN 
n=HlNLKV(J.Jl-l)*2 
I2=RI'JLrV  (J.  J1 ) ♦! 
on  10  13=11.12 
L CHAR  (JO. 13) =SYM60L (J1 . JO) 
rONTiNUK 

FL0INP(4)=FL0INF(4) 

An=n 

PPTS=PTS 
AOPES=NAOR£S*An 
IF(PTS.lK.llO)  GO  TO  S 
FLO  IMP  (5)  =Fl.niNP  (4)  ♦ 109*FLDINP(6) 

GO  TO 

FL'HNR  (5)  =FL0INF  (S) 

PTS=PTS-1 I 0 

initial I7F  TAPE  PEAOING  FOR  THIS  FIELD 
CALL  FLOIkT (FLOINP.FFT.NFFT) 

NSAPP=  (‘  LiiPiP  (S)  -FlOINP  (4)  ) /FL0INP(6)  ♦! 

IF  (Nsa‘^p.gf.)1o)  go  to  101 
IF  (NSA'^P.'-  O.PPTS)  00  TO  101 
WRTTF(^.IOO)  FLOINP(S) 

PTS  = o 

FLniNF (H) =Fl  niNP(S) 

100  FORMAT (•  YOU  HAVE  ASKED  FOR  TOO  MANY  SAMPLES.  ThE  LAST 

* TS) 

CONTINUE 

1.  IMES=(FI.1.'INP(2)-FL0INP(  1)  ) /FLOINP  ( 3)  ♦ 1 
TYPF=1 
FFTNUMrJ 

CALL  hFADMG( TYPE. FETNUM.B I NLEV.NUMH IN. FLOINP .SYMBOL. 

• NSAwP.KET.SYPniM, TCOL) 
tcol=i 

LINCNT=0 

PFAO  AND  FILL  20  PUFFERS 
no  44  JArl.'-'OUFS 

call  RRi-AlKAOMES.PUFd.JA)  . NS  AMP  . JST  AT  ( JA ) ) 

AORFR^ADPf  S*NPUFS? 

1.  INCNT  = LIUCNT*1 
COMTINUF 

1 INF=LIMSTR 
IHHF=1 

FINIvhfu  UEADifjG 

3G  IF ( JPTaT ( IMUF) .fU. 1 ) GO  TO  36 
no  200  ‘P=l.NSAMp 
L IN  (PM)  =r'L»>NK 

CALL  Fni.I  '.  r ( vFSTCG.NC.FL.L  INF.  .NS.  JJ) 
riO  14  JU=1.^YMD1M 
L = 1 


PIC00800 
PIC00810 
PIC00820 
P1C00830 
P1C00840 
PIC00850 
PIC00860 
PIC00870 
P1C00880 
P1C00890 
P1C00900 
PIC00910 
PIC00920 
PIC00930 
PIC00940 
PIC009S0 
PIC00960 
P1C00970 
PIC00980 
vert  ICES (SAMPPIC00990 
PICOIOOO 


5 

6 


101 


44 


200 


PICOlOlO 
PIC01020 
PiC01030 
plcoio40 
PICOIOSO 
PIC01060 
P1C0I070 
PICOlOflO 
P1C01090 
PICOl 100 
PICOlllO 
PICOl 120 
PICOl 130 
PICOl 140 
PICOl ISO 
PICOl 160 
PICOl  170 
PICOl 180 
PICOl 190 
PIC01200 
P1C0121O 
P1C01220 
PIC01230 
PIC01240 
PIC012SO 
P1C012G0 
PIC01270 
PIC01280 
PIC01290 
PIC01300 
PIC01310 
P1C01320 
PIC01330 
SAMPLE  IS‘.PIC01340 
PIC013S0 
PIC01360 
PIC01370 
PIC013P0 
P1C0I390 
PIC01400 
PIC01410 
PIC01420 
PIC01430 
PIC01440 
PIC014S0 
PIC01460 
‘ P1C01470 

PIC01480 
P1C01490 

Picoisno 

PICOISIO 

PIC01S20 

P1C01S30 

PIC01S40 

PICOISSO 

P1C01S60 

PIC01S70 

PICOISPO 


riLF:  PICT 


no  201  lAsl.NSAMP 
Kft=(U-D*SAMINC*FL0INP(4) 
no  202  JK=L.JJ.2 
IF(KA.LT.FL(JK) ) GO  TO  201 
IF(K*,GT.FL(JK*1J)  GO  TO  203 
I0T=RUF(IA.IRUF)^1 
L1N(1A)=LCHAW(J0.I0T) 

GO  TO  201 
203  L=l.^2 

IF(L.GT.JJ)  GO  TO  20S 
20?  CONTINUE 
201  rONTINIlF 
205  CONTINUE 

TF(J0.NE.2)  GO  TO  21 

WPTTF(fi.l7)  LINE. (LIN(JK) ,JKsl,NSAMP) 
wPTTF(G.in2)  LINE 
102  FORMaT(1H*»T122»15) 

GO  TO  14 

17  FOPf'‘AT  (lH.,I5.4X,110An 
71  WRTTF(6.1S»  LINE, (LIN(JK) ,JK=1.NSAMP) 

15  FO°NATn6,4X,110Al) 

14  CONTINUE 

L1NF=L1NE+LTN1NC 

LINCNT=LINCNT*1 

IFtLINCNT.GT. LINES)  GO  TO  37  ^ 

CALL  R«eAl)(A(jPFS.RUF(l,IBUF)  .NSAMP,  JSTAT  ( 18UF)  ) 

An»ES  = Ai-)PE5*NHUFSZ 
37  IflUF=IMUF*l 

IF  (IPUF.GT.L'HUFS)  1HUF  = 1 
IF (LInf.LE.LINEND)  GO  TO  36 
TyPF=7 

CALL  HFADNr,  (TY°E.FETNUM,B1NLEV.NUM8IN,FLDINP, symbol. 
* NSAMP, FET  .SYt^niM.TCOL) 

FLniNP(4) =FL0INP(6) ♦FL0INP(5) 

A0  = An.  1 10 

TFIPTS.GT.O)  GO  TO  7 
4 CONTINIJK 
GO  TO  70 

1 TFtPUNNO.EQ.O)  RETURN 
GO  TO  20 
ENH 


PIC01590 

PIC01600 


PICOI63 
PIC016< 
P1C01630 
PIC01640 
PIC01650 
PIC01660 
P1C01670 
PIC01680 
PIC01690 
P1C01700 
PIC01710 
PIC01720 
PIC01730 
PIC01740 
PIC01750 
PIC01760 
PIC01770 
PIC01780 
PIC01790 
PICOlflOO 
PICOIHIO 
P1C01820 
PIC01830 
PIC01840 
P1C01850 
PIC01860 
PIC01870 
PIC01880 
P1C01890 
PIC01900 
PIC01910 
PIC01920 
PIC01930 
P1C01940 
PIC01950 
PIC01960 
PIC01970 
PIC01980 
PIC01990 


0,1  ' ’ 


V 


noo  r>  n n rt  n no  nr>onnonnor>or>nnnr>rmr>n 


FILF:  SETUPiS 


SUPPOUTINE  SETUP6(FlLHlStfllNCNT»B INLEV »NUMBIN»SYMB0L»SYMCNT» 
* SYMniM) 

C 

IMPLICIT  INTEGER(A-Z> 


CALL..  CALL  SETUP6 (FILHIS) 

APGS..  FILHIS  - HISTOGRAM  DATA  ARRAY 

REQUIRES  COMMONS  /INFORM/  /INFORS/ 

/GLOeAL/  /HELP/ 

ROUTINES  MXTCHR  FIN012  NUMBER 

PURPOSE..  READS  AND  ANALYSES  CONTROL  CAROS  FOR  tGRAYMAP*  STEP 
RETURNS..  SUPERVISOH  INFORMATION 


fNCLUOF  COMPK3.L1ST 
INCLUDE  COmbka.LIST 
TNCLUnE  COm^k^.LIST 

COMMON  /GRCPLK/MaXFFT.NOFEAT.NOFET2.FETVEC(30)  . 

* FETVCPOO)  .FL0INF(6)  .INFMT.FILESV.NOHIST. 

* HISVECOO)  .NOFLD.  FLDPTS 

*.x<;iz.xi.ow.xhgh.ysiz 

n I MENS  TON  mEDI < Ih) .HED2(15) .DATE (3> .COMENT(IS) 

EQUIVALENCE  (HEO 1 ( 1 ) .HE AD ( A ) ) , (DATE  U > .HEAn(?2)  ) . 

2 (HE02(1) .HEAOI30) ) . (COMENT ( 1 ) .HEAQI 48) ) 

common/global/he AD(63) .mapT AM .DAT  APE . S A VT AP.RMFILE *BMKEY. 

* misfil.hiskey.trform.eriptp.ehpkey.mapunt.nofilf, 

* noni-iAD.DR'lM)S.PAGSIZ»nATFIL»STAFIL.  ASAV.ASAVFL 

* .NHSTUN.NhSTpI.SCTHUN.MaPEIL 

* .POTtitiT  .noTFIL.NCHPAS.TPNSFL.BMTPFL.HlSTFLf  PCHUNT. 

* CKOUNr.PWTUMT.HAfJOIO 

SEND 

COMMON  /HlSTOR/hF 

equivalence  (KLOINF ( 1 ) .LINSTP) . (FLO  INF (2) .LINENO) , 

« (FLO  I ME  n) .LINING) . (FLO  INF (4) .SAMSTH) , 

* (FLDIN'F  (5)  tS AMEND)  . (FLO INF  (6)  .SAM INC) 

DIMENSION  Fi-'VECl  (3)  .E)JVEC2(3)  .NUMVECOO) 

dimension  symbol (14.2). AC AMO (20) 

dimension  CIM'FX (10) .HINLEV (30. 16) .EQUVEC (?) . 

*SINVEC (3) .CARD? (62) .HGTPT (30) .FILHIS (NOKE AT. 256) .COMMA (2) 

EOUIVAI  FNCE  (SINVFC  (3)  .E(3UAL) 

DATA  C INDEX/ ICHAN • . • B I NL • . • S YMB • . *EORM» . 'HEDI  • * 

» IHFD2'  .•COmm'.iuaTE*. '‘END' . 'DATA'/ 

OATA  EOUVEC/1 . *= •/ 

DATA  SlNVFC/2. ' . • . '='/.CINmaX/10/. 

« RI.An^/*  '/.CUMM/./i  , . , ./,ePVEC1/2.  • 1 • . '0»/. 
oEPMEC?/?,  'll'.  »L'/ 

DATA  MncO/'Hi/.nhCD/ •O'/.XBCn/*X'/,nLRBC0/«»'/.DOTBCD/' . •/. 

1 FOLnCf'/'  = '/.MNSPC0/'-'/.SLHBC0/'/'/.STRflCD/'*«/.FiLK8C0/»  •/  . 

2 F«CD/ 'E'/.ORCD/'U'/ 


IK  = 1 

►;offt?  = .) 
maXFET=30 

TE(HE.Eo.l)  GO  TO  60 
SYMOTM=n 
MOMuiNri) 

MINCNT=0 

SETUP  reread  buffer 

CALL  RFREAD(30.60) 

14  rOL=0 
C PUT  ^!SXT  CAHO  IN  RUFFFR 

RFAIHPl  ,200)  ( ACARD(  I ).  1 = 1 .20) 
?00  FOMmaT  ( BOA'. ) 

MRI TK ( TO, 200) (ACARD(I) .1=1.20) 
PEWINO  HO 


SETOOOlO 
SET00020 
SET00030 
SET00040 
SET00050 
•SET00060 
SET00070 
SETOOOflO 
SETOOOVO 
SETOOlOO 
SETOOl 10 
SET00120 
SFT00130 
5ET00140 
SETOOISO 
SET00160 
SET00170 
SETOOlflO 
SETOOlPO 
■SET00200 
SET00210 
5ET00220 
SET00230 
SET00240 
SET00250 
SET00260 
SET00270 
SET002B0 
SET00290 
SET00300 
SET00310 
SF.T00320 
SET00330 
SET00340 
SET003S0 
SET00360 
SET00370 
SFT00380 
5ET00390 
SET00400 
SET00410 
SET00420 
SET  0 04 30 
SET00440 
SET004S0 
SE  T 00460 
SET00470 
SET004B0 
SET00490 
SF.TOOSno 
SET  0 0b  10 
SET00b20 
SETOO'330 
SET00540 
SETOObSO 
SETOObGO 
SFT005/0 
SETOObHO 
SETOObPO 
SFT00600 
SETOOMO 
St  T00620 
SET00630 
5ET00640 
St  T006SO 
SET  0 0660 
SFT00670 
SET006H0 
SET00690 
St  TOO  / 0 0 
St:  1007  1 0 
St  TOO /20 
St  T007T0 
St  TOO  7-0 
SFT007G0 
St  TO07C.O 
St  TOO?  / O 
St.  TOO  / HO 
St  TO07N0 


nnn 


FILE:  f?ETUP6 


GO  TO  14 
C HEOl  CARO 

R »EAn<30*2'»)  HEDl 
REWIND  30 
GO  TO  14 
C MFD?  C»RO 

q REAn(30.?5)  HE02 
rewind  30 
r-0  TO  14 

?5  format (10X«15A4) 

C COMMFNT  CA«0 

10  PEAD(30.25)  COwENT 
REWIND  30 

GO  TO  14 
C DATE  CARD 

11  M=NXTCHP(CARD2,COL> 

IF (M.EO. BLANK)  GO  TO  14 
»FAn(30.25)  DATE 
rewind  30 
60  TO  14 

DATAFILE  POSITIONING  CARO 


1701  MrNXTCHP (CAR02«C0L) 

IF  CM. EO. BLANK)  GO  TO  14 
TF  (M  ,EO.  UBCD)  GO  TO  1702 
TF  (M  .FO.  FPCD)  GO  TO  1703 

170S  wRTTF(f..l704) 

1704  FORMAT  (•  ERROR  ON  DATA  FILE  CARD  •) 
GO  TO  14 

170?  J=FIn01?(CaRD2,COL.EQUVEC) 
TF(J.FO.-l)  GO  TO  170S 
MsNliMHFR  (CA»D2.  COL  t OAT  APE*  ZERO) 
rOL=COL -1 
GO  TO  1701 

1703  J=FINO)  2(CARD2*COt.*EOUVEC)  . 
TF(J.KO.-l)  GO  TO  1705 
FII.N0=A'UMBFR  tCAf<U2*C0L*0ATFIL*FILN0) 
DATFTL=nATFlL-l 
COL  = COL--l 


GO  TO  1701 
C opMO*  CAi-0 

1?  TFCMSYM.FO.1 ) 
C DFFAill  T SYMBOLS 

<;ymcnT  = 10 
«;ymdim  = ? 
symbol (1.1)  = 
SYMBOL (1.2)  = 

SYMOOI.  (?,  1 ) = 

SYMHI1L  (?,?)  = 
SYMBOl  (1.1)  = 

SYMhOI  (3.2)  = 
symbol (4.1)  = 
SYMBOL!'*.?)  = 
SYMBf/L(s,l)  s 

symbol (S.2)  = 

symbol (B.l)  = 

SYMROI.  (•',.?)  = 
SYMBOL  (7.1)  = 
SYMBOl  (7.?)  = 
SYMBOI.  (B,l)  = 

symbol  (‘'.2 ) = 


GO  TO  26 


BBCD 

OLPBCO 

XRCO 

EOLBCO 

oBcn 

M(,iSBC0 

OBCO 

OBCO 

STKHCO 

MNSPCD 

FOLUCO 

FOLRCD 

nOTBCO 

OuTHCO 

MNSuCD 

MNbbCO 


symbol  ( •! 

SYMBOI  (■) 

symbol ( 1 


1 ) 
2) 

1 ) 


SLHBCO 
SLHBCO 
= BLKRCU 


symbol ( 1 n . 2)  = BLKfiCO 


CHFCK  TO  SFF 

IF  B 

iNLtVtLS 

INPUT 

?6 

IF( 

RP/GOT 

• FO. 

1)  GO 

TO 

27 

Nll'X 

H T N - B y 

'•CMT 

TF  ( 

HISF  II. 

.O'-' . 

13)  S 

TOP 

? 

WF  AD 

1 Hi 

STOG^-'A 

M AND  CAL 

CUL 

atf: 

BI 

TF  ( 

Mm**  *-  Y 

.F(J, 

1 ) GO 

TO 

30 

NOF 

FAT  = *0FlT? 

DO 

B1  T/- 

1 .’jOFFT? 

«l 

FFT 

Vt  C ( IZ 

) F 

TVC2( 

17) 

PFT 

URN 

PO 

BF  A 

n(-iisF 

U ) 

LOF> 

AT  . 

(F'E 

tvf: 

PF  A 

n (bIsf 

ID 

( (F  IL 

Mis 

( 1 . 

J) . 

RFW 

I NO  HI 

SFIL 

binlevels 


I =1 .NOFFAT) 
■56) . 1=1 .NOFFA 


T) 


SET01590 
SET01600 
SET01610 
SET01620 
SET01630 
SET01640 
SET01650 
SET01660 
SET01670 
SET01680 
SET01690 
SET01700 
SET01710 
SET01720 
SET01730 
SET01740 
SET01750 
Sf T01760 
SET01770 
SET01780 
SET01790 
SETOlaOO 
SET018I0 
SET01820 
SET01830 
SET01840 
SET01850 
SET01860 
SET01870 
SET01880 
SET01890 
SET01900 
SF TO  1910 
SET01920 
SFT01930 
SET01940 
5ET01950 
SET01960 
SET01970 
SET01980 
5FT01990 
5ET02000 
SET02010 
SET02020 
SLT02030 
SET0?040 
SET02050 
SET02060 
SET02070 
SET020B0 
SFT02090 
SLT02100 
SET021 10 
SET02120 
SET02130 
SET02140 
SET02150 
SET  02 160 
SET02170 
SET02180 
SF,  T02190 
SFT02200 
SKT0221U 
SET02220 
SET02230 
SFT02240 
SL  T02250 
5FT02260 
S) T022  70 
SFT022R0 
SF  T02290 
SFT02300 
SFT02310 
SF  T 02320 
SF  T02330 
Sf.T02340 
SFT023BO 
SFT 02360 
SFT  02370 


FILF 


SETUP6 


44 


ARHAY»  FETVEC  ARRAY, N0FET2»N0FFAT 


00  44  Tal, NOFEAT 
HGTPTd  )*0 
no  4S  lal.NOEEAT 
DO  4?  Jal,2S6 

4*i  HGTPT(I)aM6TPTt  n*FILHI5(l,J) 

IF  FF4TUPF<i  card  NOT  INPUT, FETVC2 
IF(NOFFT2,NP.0)  GO  TO  60 

nofft?=nOfeat 
no  61  1=1, NOFEAT 
N1  FFTvr?m  =FETVEC(1) 

GO  TO  100 
60  TK=1 

KT=n0FFT2 
in?  00  ?«  1=1 ,KT 

no  ?Q  J=l. NOFEAT 

CHECK  TO  GFE  IF  FEATURES  HISTOGRAMMEO 
TF(FFTVC2<I).UE.FETVeC(J>)  GO  TO  29 
GO  TO  ?H 
?9  rOMTINMP 

wPTTF(6,3n)  FETVC?(H 

30  FORMdTdX, 'THIS  CHANNEL  IS  NOT  HISTOGRAMMEO* , 13//) 
N0FFT?=N0FET?-1 
TF(I.GT.KT)  GO  TO  100 
IK=I*1 

no  101  II=IK,KT 
im  FFTvr?(II-l)=FFfVC2(II) 

KT=MOFFT? 


100 


TKrI 
GO  TO  102 
rONTINUK 

no  101  1=1, 

no  104.  J=l, 


"0FFT2 
NOFF AT 

IF(FFTVr.2(l)  .KF.FETVECUn  GO  TO  104 
GO  TO  1? 

104  rOMTlNUF 

COMPUTE  oTNI.evEI.S  fop  FEATURE 
3?  1 rMGTPT  ( J)  /niJMh  IN 
I NliM=MiMHlN-l 
M=| 

N = 0 
K = 0 

no  33  JJ=l,l.fJUM 
34  K=K«1 

N = N,FIt  HIS( J.K) 

TF(N.LT.M)  go  to  34 

M = M*|. 

f'lNLFV  ( I ,JJ»  =K-1 
IF(JJ.^T.1)  GO  TO  111 
IF(K.KO.l)  -1NLEV(I,1)=1 
GO  TO  33 

1 1 1 IFIPiril  FV  ( I ,.JJ)  .EO.RINLEVd,  JJ-1)  ) 

33  rONTINUP 

r.  IM|  FV  d .NIJMfil.N)  s?55 

103  roOTIM'F 
?7  rnoTiM.'F 

PDIMT  nijT  GFTIIPg  capos 

wPTTh  (6,4  0)  (EFTVC2d)  ,1  = 1,N0FET2) 

40  format  d X . *‘:ilPFRVISOR  INFORMATION  FOR  GRAYMAP'/IX, ‘CHANNELS 
*ppcn  APF',3014) 

UPITF  OUT  SYMBOLS 

WPTTF (6.41)  (SYMmOL (KZ, 1 ) ,KZ=1 ,SYMCNT) 

41  FOPM-'K*  SYMpnt.S  DSEO  IN  G»AYMAP  ARE  • , 1 6 ( 2X  , A 1 ) ) 

IF(SVMniM.E  ).F)  /.RITE(6,4?)  (SVMH0L(KZ,2)  ,KZ  = l,SYMCf’l  i 

4?  rOPMAT dh*,?7x, 16(?X,A1) ) 

(HTUHN 

FNO 


PINLEV(I,JJ)=BINLEV(I,JJ-1)*1 


SET023G0 
SET02390 
SET02400 
SET02410 
SET02420 
SF.T02430 
S^T02440 
SET02450 
SET02460 
SET02470 
SET024fl0 
SET02490 
SET02500 
SET02510 
SET02520 
SET02530 
SET02540 
SET025S0 
SET 02560 
5ET02570 
SET02580 
SET02590 
SET02600 
SET02610 
SET02620 
SET02630 
SET02640 
SET02650 
SET02660 
SET02670 
SET02660 
SET02690 
SET02700 
SET02710 
SET02720 
SET0P730 
SET02740 
SET02750 
SFT02760 
SET02770 
SET02780 
SFT02790 
5ET02800 
SET  028 10 
SET02H20 
SET02830 
SET02H40 
SET02850 
SET02860 
SET02870 
SET02880 
SET02890 
SET02900 
SET02910 
SET02920 
SET02930 
SET02940 
GRAYMASET02950 
SFT02960 
SET02970 
SET029H0 
SE  T0?990 
SET03000 
Sf T03010 
SET03020 
SET03030 


8 . STAT  PROCESSOR 


FK.F:  STAT 


SUflROUTINF  STAT tARMAr. TOP) 

[ PUPP05F,.  COOPniNATFS  THE  VARIOUS  ROUTINES 

[ fok  istatistics*  step 

IMPLICIT  INTFCiF.R  (A-H,0-Z) 

OOUBI  E PRECISION  ARRAY  USOO) 

niMENSION  KEPPTS(60) 

iNCLun':  comuka.list 

STAT  common  hlock 

COMMON  /STHJSF/SUIjSV1,SUBMN1 tSUPVPl ,SUPSD1 .SUBCL1»SAVER1»HSTaL1* 
•SPFCl .roVAHl . AVAR  1 ,CLS 101 ,FLMEN 1 » FL V AO] .HFTAL 1 .FLOSV 1 
COMMON  /STCn.K/  MAXFFT.MAXCLStMAXFLO.NOFEAT*NOFET2t 

*VARSl7.wOSRPr.NOHlSTfSPCHiAStIrtLOCK(3n)  .FtTVECOO)  * 

•FFTVC?(  T(')  ,HlSvFCCiO)  .NUFLO.NOCLSt 

* FLOI-’F  (»5)  .FI.OPTS,CI.SPTS.XSIZtXHGM,XLOW,YSIZ  , 

COMMON  BLOCK  STHASt  CONTAINS  THE  BASE  ADDRESSES  FOR  THE  STATISTICS 
STORFD  IN  ♦ARRAY* 


SUBS VI  - 


IN  iaRRAY*  for  SUBCLASS  INFORMATION 


BASF  AOURESS  IN  lARHAY'  FOR 
(S*SURNO) 

for  FACH  SUBCLASS  INOE* 


FUPMN]  - 
siipypi  - 

suosoi  - 

SURCL 1 - 
SAVF.Pl  - 
uSTALI  - 
SPFCl  - 

cnvARj  - 
AVAOl 
CLSIOl  - 
FLMFNI  - 
FI  VflRl  - 
HFTAL1  - 
FLOSV)  - 
CONTIfj'IF 


- HaSF  AOORFSS 

- ha<^f  adore  SS 

- HASP.  AOnr^FSS 

- BASF 

- mase  AOORF.SS 

- BASK  adobe ss 

- BASE  ADOPESS 
( i-*r  OEPtC) 

- ha<;e  AOOPFSS 

- MABF  address 

- BASF  AOObE.SS 

- AOO'yESS 

- fiAEE  AyORE  SS 

- babe:  AOIJvESS 

- BASF  A()ube:SS 


• ARf?AY 
•ARRAY 

• ARRAY 

• ARRAY 

• ARRAY 

• ARRAY 
•ARRAY 

•ARRAY 

IARRAY 

• ARRAY 

• ARRAY 

• ARRAY 

• array 

• ARRAY 


JOE*  1-CLASS  number 

2- starting  field  number 

3- fnoing  field  number 

4- SUPCLASS  NAME 
FOR  SUBCLASS  MFanS 
for  SUBCLASS  VARIANCES 
FOR  SUBCLASS  NAMES 
FOR  CLASS  NUMBER 

FOR  TRAINING  field  VERTICES 
FOR  SUBCLASS  HISTOGRAM  TOTALS 
FOR  SPECTOGRAM  INFORMATION 

FOR  FIFLD  covariances 

FOR  FIELD  MEANS 

FOR  CLASS  names 

FOR  FIELD  MEANS 

FOR  FIELD  variances 

FOR  FIELD  HISTOGRAM  TOTALS 

FOR  FIELD  information  (10*MAXELKi 


FONT  T \Uf- 
COMMON  HI  0C^ 


FOiV  FACH  FIELD  INDEX  1-FIFLO  NAME 

2-CLASS  NUMBER 
B-SUBCLASS  number 

a-numbfr  of  vertices 

5- STAbTING  LINE  number 

6- FNDING  LINE  number 

7- starting  sample  number 
a-fnding  Sample  number 
b-line  increment 
10-sample  increment 

STCHLK  contains  information  NFEDFO  by  routines  in  STAT 


maxFFT-  maximum  nijndpr  of  ChaNNFLS 
KAYCI  S - iumh»-R  of  CLASSES 

MAVFin  - MAKIMUM  NUMHI- R OF  FIELDS 
NOF«-  aT  - OK  C'AUnEi  S RpiJUbSTEn 

_ SI-'^  OF  F ACh  covariance  MATRIX  ( NOF  E AT  • ( NOFE  A T ♦ 1 ) /? 

Nn«;PFC  - w U^  o voups  Of  SUBCLASSES  TO  PLOT 

norist  - NUBRFJ  OF  Channels  to  histogram 

SPCHAS  - MINIMUM  RAUMNCE  value  ON  Y AXIS  OE  SPECTRAL  PLOT 

TrtI  OCX  - AuRAV  CUN  r A I TuIUiU'RS  TO  certain  OPIlONS  IN  STAT 

Fffvi-r  - array  (IE  channels  SELECTED 

HISVFC  - AnRaY  of  channels  to  Mi'aTOGWAM 

NOFI  D - NHM  -KR  (iF  E it  l.DS 

NOn  S - N'jmRi-k  of  classes 

FL^iiNF  - F [FI  n iru  (,|‘v«'AT  lUTJ  ARRAY 
n nPTS  - 1)F  POINTS  IN  FIELD 

Cl  SETS  - NUM.H  R UE  POINTS  IN  CLASS 
XST7  - AP'M-XLO.'  =101 

XI  f)W  - X VAI.uk  lu  BE  MISTOGPAMMFn  =0 

XhGh  -M.'.XlMOM  X VAI  UF  TO  BE  hISTUGPAMMED  =2S5 
YSIZ  - height  OE  Y AXIS  IE'  HISTOGRAM  =1S 

CAI  L SFTUPl  ( ARRAY . TOP. MAXSUB) 

CALL  LE  ARN  ( ArPA Y ( SPE  C ) ) * APR  A Y ( CO V AR 1 ) . ARB  A Y ( 4 V AR 1 ) t 


staoooio 

ISTA00020 

1STA00030 

JSTA00040 
STA00050 
STA00060 
STA00070 
STAOOOBO 
STA00090 
STAOOlOO 
STAOOllO 
STAOOI20 
STA00130 
STAOOUO 
STA00150 
STA00160 
STAOOl 70 
STAOOieO 
STA00190 
STAOozno 
STA00210 
STA00220 
STA00230 
STaOOZAO 
STA002S0 
STA00200 
STAfl0270 
STA002B0 
STAfl02B0 
STA00300 
STA00310 
ST400320 
STA00330 
STA003AO 
STA003S0 
STA00360 
STAC0370 
STA003B0 
STA003Rn 
STA00400 
STAOOAIO 
')  STA00A2O 
ST  400430 
STA00440 
STA004SO 
ST A004B0 
STA00470 
STA004BO 
ST A004VO 
STA00500 
STAOOSl 0 
STA00S20 
STA005.30 
STA0OS40 
r STA005S0 
STAOOSGO 
ST A00S70 
ST  AOOSEtO 
ST APOSPO 
ST AOOgOO 
ST AOOgI 0 
STAOOcjPO 
ST  AOCh  lO 
STAO0O40 
ST  AOOfeSO 
ST  AOOhOO 
ST  AOOE.70 
ST  AOObHO 
ST  Anoe.BO 
s T A n n 7 n 0 
STA007  1 0 
STA0P7P0 
S T A 0 0 7 3 p 
ST  AP07RU 
STACP7S0 
STAOO  700 
ST A0077U 
S T A P 0 7 B 0 
STAOO  7U0 


♦ # • • 


FILFt  ST4T 


uRtTF  (#*.?» 

FORMAT (////////// 
PFTURN 
END 


tM«*Y (CLSini ) * ftRKAY (SURSVH . ARRAY (FL^ENl )« ARRAY (FLVARl ) STA00600 
ARRAY  (SUP^NDt  ARRAY  (SUBVRl)  » ARRAY  (SUHSOj  ) i ARRAY  (SUBCL 1 > ST  AOOPig 
ARRAY(MFTAL1» .ARRAYIHSTALU .ARRAYJFLOSVl) * SlAOOftgO 

ARRAY  (SAVEHl)  .KFPPTSf  HAXSUB)  §I'‘t*9$30 

STAOOSaO 


SSTAT  - COMPLETED  /////) 


STAOOeSO 

STA00R60 

STA00870 


3^ 


ii 


r>r\n  n t\i  orjn  ^ r>nr>n  r>  n 


FILF:  CLSSPC 


•5URR0UTINF  CLSSPCIMFan.SURST0.10VEC«PTRVEC.PL0T» 
*TITLEtN0FEAT,FETVEC»SPC8AS> 

implicit  INTEfiEH  (A-M,0-Z) 

L06ICAI  OVWFLG 

REAL  MFAN(l),SUflSTDn)  .8lAS«lNCRtMENI»0EVI 
OOUPLE  PRECISION  DEV(U .OMEAN(l) 

niMENSION  PLOT (4, nofeat. 49) ♦PTRVEC(S) 

DIMENSION  FFTVEC(30) 

4.  SYMVFC<4) ,TAP(1?) .ERHLIN(7) 

INCLUDE  COMRK6.LIST 

COMMON/r-LOHflL /HE  AD  (63)  .MAPTAP.0ATAPE»SAVTAP.BMFILE*PMKEY» 

• HlSFIL.HlSKFY.THFOHM.EHIPTP.tRPKEY.MAPUNT.NOFlLF. 

• nRUMAO«OPMi,OS.PAC'SI2.DATFlL.STAFIL»ASAV.ASAVFL 

• ,n-!STun.nhstfi  .scthun.mapfil 

• .niiTUNT.nOTETL.NCHPAS»TRNSFLtBMTPFL»MlSTFL*PCHUNT» 

• rPnUNT.PWTUNT.HANOIO 


DATA  SYmvEC/"»». INCP/3.0/.  NOLINE/49/. 

1 BLANK  /•  •/ 

DATA  TAB  / • 1 ? • ♦ • ?0 • . • ' 36 • . • 44 • « »S2 ' 

1 . • 6 0 • . • 6H • . • /b • . • 84 • . * 9? • . • 99 • / 

DATA  FRHLIN/»(1H*».*.T  • . • . IH ( • . • . A1 . • . • IH) . • * • I 3)  '/ 

DATA  DASU/i — — •/ 


SPEC  lUI? 


VRTTF  (iS.HC/.n) 
wRTTI-  (4,  10031) 

0n?l  FORMAT ( 34X. 'SPFCTHAL  PLOT  (MEAN. PLUS  AND  MINUS  ONE  STO.  DEV. 

1 for:*  / ) 

WRITE  ('•,  1003)  TITLf  . (DASH . I = 1 . 2) 

100?  rORMAT (A4 'TRAINING  SUBCLASS  • . A4/44X . 4A4 » A2/) 

WRITE  (<'•.20031  ) 

WRITE  (N.‘/003)  SYMVEC(?)  f IDVEC 
GO  TO  /‘’O 


FNTWY  FI  OSPC  (OMEAM.DEJV.  iovec.pthvec.ploi  .mean.substo.flonam. 
"UOFFAT  .EFl  VECSPf.GAS) 

WRITE  (*>.nE  AO) 

WHITE (6, 10031 ) 

white  (4. 1 0 04)  invFC. (DASH. I si .4) 

1004  FORMAT (4 7/ . 'TRAINING  FIELD  ' . A4/46X .4A6/) 

WRITE (4,P0031) 

0021  F0HMAT(  / 47*.  'RIOT  lEGENO:*  / 47X.  • ) 

WRITE  (4,;=003)  SYMVFC(3)  .IDVEC 
3002  FORMAT (on*. A1  , ' s FIFLO  ».A4) 

no  100  JsI.nOFEAT 
lOO  MFAN(J)  s I)meaN(J) 
no  3'yR  1 = 1.NOFFaT 
3<)R  ^U“STO  ( I ) rOFV  (I) 

?F0  JRFTR  = 3 
JPt.OT  = 2 
JPTAS  s 1 

COME  INF!)  P4IZ 

300  RIAS  = SWCHAS 

WRITE (4,4003»HLANK 
CNT  = (<1AS 
OVRFl.W  = 0 
OVRFl  G = .TRIIF. 
no  3N0  (sI.iOFFAT 
no  3Sn  1=1,4 
no  3RO  1 , 4w 
JFO  PLOTd.J.K)  = PLANK 

t or  = i 

ISTORrEOFE AT 

IF  (NOFE  AT.f,T.  12)  IST0R  = 12 


CLSOOOIO 
CLS00020 
CLS00030 
CLS00040 
CLSOOOSO 
CLS00060 
CLS00070 
CLSOOO0O 
CLS00090 
CLSooiog 
CLSOOilO 
CLS00120 
CLSOOISO 
CLS00140 
CLS00150 
CLS00160 
CLS00170 
CLSOOISO 
CLS00190 
CLS00200 
CLS00210 
CLS00220 
CLS00230 
CLS00240 
CLS00250 
CLS00260 
CLS00270 
CLS002H0 
CLS00290 
CLS00300 
CLS00310 
CLS00320 
CLS00330 
CLS00340 
CLS003S0 
)CLS00360 
CLS00370 
CLS00380 
CLS00390 
CLS00400 
CLS00410 
CLS00420 
CLS00430 
-CLS00440 
CLS004SO 
CLS00460 
CLS00470 
CLS004A0 
CLS00490 
CLS00500 
CLSOOSIO 
CLS00520 
CLSOOSIO 
CLS00S40 
CLS00S50 
CLS00S60 
CLS00S70 
CLSOOSHO 
CLS00S90 
CLSOObOO 
CLSOOblO 
CLS00630 
CLS00630 
CLS006<,0 
CLS006S0 
CLS00660 
CLS00670 
CLS00680 
CLS00690 
CLS00700 
CLS00710 
CLS00730 
CLS007.30 
CLS00740 
CLSOO  7S0 
CLS00760 
CLS00770 
CLS00780 
CLS00790 


jy 


u u u v;oc'o 


i CLSSPC 


g SET  UP  'PLOT*  MATRIX 
JKSV»n 

AOO  no  690  JP»JPST«*JPL0T 

MPM8AS  * (HTRVFCIJP-J8IAS)-1)*N0FEAT 
IF(  0VPFL6)  MRITf<6*A002) 

4002  F0OMAT(A4) 

0VRFL6  » .false. 

JKxJKSV 
JF  » 0 

no  500  JFEATxLOC.ISTOP 
JK  a JK^JFt'AT 
mFNI  a MF4N(MENHAS*JFEAT» 
nEVIa5UHStr)<“EN8AS*JFEAT) 

MFNUOW  a (KFNI-DEVI-BIAS»/INCR*0.5 
a (nENI*0EvI-PI4S)/iNCH*0.5 
IF(  HFNLOw  .CE.  I)  60  TO  430 
OVPFLW  a MEn!-DFVI*0.5 
HFNLOV  a I 

4.10  IF(i-F.NH6H  .LE.  NOLINE)  GO  TO  450 

OVRFLW  a ME.Nl  .nFVl*0.5 
MFNHGH  a NOLINE 

450  00  4W0  J aPFNLOW.MENHGH 

490  PLOTIJP.JFEAT.J)  a SYMVECUP) 

JF  a JF  ♦ 1 

TF(OVRFU»  .FO.  0 ) GOTO  500 

C*****JF  a JF  ♦ 1 This  statement  moved  up  one  line  ••«•***•• 

FR»L1N(1)  aTABUF) 

WRITE(6.EPHL1N)  SYMVECUP)  .OVWFLW 
0V9FL0  a .TRUE. 

OVRFLW  a 0 
500  CONTINUE 

6R0  CONTINUE 

PRINT  OUT  'PI.OT*  matrix 
waiTF  (f.,.1004)  CNT.CNT 

3004  FORMAT!  4^,13.  ?X.  'I P.  12P P)*  2X,  13) 

CNT  a cur* INCH 
700  no  700  Ks  1. NOLINE 

write  U'l.  7 no?)  CNT,  I (Pt.OT  (I»J,«),IaI,4>  , JaLOC  . ISTOP) 
WRITE (N, 700 3) CNT 

700?  format (4X, n.?x, II  I , 12(4X,4A1 ) ) 

7003  FORMAT ( I ♦ I ,11  i*  ,1 P ,2X,I3) 

CNT  = CNT*1NCR 
7R0  CONTINMK 


000  WRITE (6, 3004)  CNT*  CNT 


WRITE  (N,f?00?)  < FETVEC(I). 

rtOO?  FORMA!  ( / l.<,  ‘CHANNEL  NO,' 
WRITF  (4  ,H003>  (DASH.  PI  .3) 
A003  FORMA! (IX.  3A4  ///) 


laLOC. ISTOP) 

. 3X.  12.  ( ll(6XfI2)  ) 


) 


IF(I5rOP.eo.MOFEAT)RETUHN 

CNTaRI AS 

JK<:v=JK 

LOr=(.OC*l2 

I5TOR=TST0P*I2 

IFdSTOH.C.I  .MOFEAT)  ISTORaNOFEAT 
GO  TO  400 


ENTRY  mijL'?PC(MEAN,5UMSTO.JOVEC.PTRVEC.PLOT. 
•NOEFAT .EFTVFC.SPCHAS) 

01*>ENSIDN  jnvFC  ( 1 . 1)  .PUF(4) 

WRITF (4,20021) 

JPSTR  a) 

JPl.OT  a prwV'Er(S) 
iF(jp(.or  .NF.  1)  Goro  900 
.JPSTR  a ? 

JPLOT  a ^ 

J0IAS  a 1 
WATsPTR^/FC  ( 1 ) 

WPITF(4,S002)  5YMVeC(2)  .JOVECd  .WAT) 

ROTO  300 

900  no  ??  JKL  = JPRTW. JPLOT 
WATbPTRVKC ( JFL) 


CLS00600 

CLS00810 

CLS006P0 

CLSO0B30 

CLS00840 

CLSOOeSO 

CLS00B60 

CLS00870 

CLSOOBBO 

CLS00B90 

CLS00900 

CLS00910 

CLS00920 

CLS00930 

CLS00940 

CLS00950 

CLS00960 

CLS00970 

CLS009B0 

CLS00990 

CLSOIOOQ 

CLSOlOlO 

CLS01020 

CLS01030 

CLS01040 

CLS01050 

CLS01060 

CLS01070 

CLS010(»0 

CLS01090 

CLSOllOO 

CLSOlllO 

CLS01120 

CLS01130 

CLS01140 

CLS01150 

CLSOlPO 

CLS01170 

CLSOUBO 

CLS01190 

CLS01200 

CLSO1210 

CLS01220 

CLS01230 

CLS01240 

CLS01250 

CLS01260 

CLS01270 

CLS012B0 

CLS01290 

CLS01300 

CLS01310 

CLS01320 

CLS01330 

CLS01340 

CLS01350 

CLS01360 

CLS01370 

CLS013H0 

CLS01390 

CLS01400 

CLS01410 

CLS01420 

CLS01430 

CLS01440 

CLS01450 

CLS014N0 

CLS01470 

CLS014HO 

CLS01490 

CLSOISOO 

CLSOISIO 

CLS01620 

CLS01530 

CL501540 

CLS01S50 

CLS01540 

CLS01S70 

CLSOISHO 


filf:  clsspc 


?2 

9002 


2p|TFikUoO?f*'(4YHV^^  (n  ,I«JPSTR»JPL0TJ 

FOPM*Tt57**<U»*  ■ SUBCLASS  *»A*» 

JBIAS  ■ 0 
GO  TO  300 
END 


3h 


r>or»n  r%nr% 


FILFs  FLnCOV 


<>Uf>RnuTtNE  FLOCOV(COn.OEV«MCANtVAR»PTStGO«FLONAH« 
•NOFEATt.-AXFFT.VAHSUJ 

IMPLICIT  INTFGFP  U-H.O-Z) 
iNCUinf  COMPK(S.LI«iT 

COMMON/6LOBAL/MFAn(63> .MAPTAP,nATAPFiSAyTAP,8MFILC»0MKEYf _ 

H|SF1L*HISkF.Y.T»FORM,EMTpTP,EPPKEY*HaPUNT»n6FILE* 
nPtlMA0.nRMM)s,t>A6SI2.0ATFIL*STAFIL»ASAV.ASAVfL 


C'FNO 

I 
I 

I 


,NH«%TI)N,NMSTFI,SCTPUN.MAPFIL 

.nOTUNT.Di>THL»NCHPAS«TftNSFL» 

CHOUNT.PPTUNT,MANDIO 


8MTRFL.MISTFL*PCHUNT. 


PUOPO<;F..  Cai-CULATL’S  TtSF  COVARIANCE  AnO  CORRELATION  MATRICES 
Fi»0  4 THE  HAW  DATA  FOR  THE  FIELDS 

’nOUWLE~PREcTsToN'cORTvARsl2TTDEvTNOFEATTTMEANTNOFEAT?TvAHTvARiTz) 


DATA  RCDT»0/  i2*  / , DASH/* / 


10 


11 


IF(  GO  ,NF.  1)  60  TO  20 

WRITE (A.HtAO) 

WPfTFIhOO)  MOFEAT 
FOPMAH’O'/*  The  MEANfSTANOAHO 


DEVI  AT  ION* covariance* AND 


FLOOOOlO 
FL000020 
FLU0QO3O 
FLDOOOAO 
FLOOOOSO 
FL000060 
FL000070 
FLDOOORO 
FLOOOORO 
FLOOOlOO 
FLOOOllO 
FL000120 
IFLO0CI30 
IFLOOOlAO 
IFLOOOISO 

Fl.OOOiflO 
-FLOOOlRO 
FLOC0200 
FL000210 
FL000220 
-FLD00230 
-FL0002A0 
FLD00250 
FL000260 
FLD00270 
FL0002R0 
CORRELATIOFL000290 


An 


N . 12.  • CHANNELS)  top:*  //) 

FL000300 

WPiTFC*).!!)  n.nNAH  , (OASM, 1*1*3) 

FL000310 

FOPMATtTSO*  iTHAlMNG  FIELP  • * AA/TAR.AAA/) 

FLD00320 

FLD00330 

Fl0003aO 

FL0003SO 

FOllATIONS  : 

FL0003SO 

FL000370 

• • N •• 

FLOO03P0 

• #«#  • 

FL0003RO 

1 • • • 

FL000400 

C0VAH<1*2)  r ♦ X X - U U • 

FLDOOAIO 

N-l»  • 12  1 2 • 

Ft.OOOA20 

• • 

FLOOOA30 

*•  J*1  •• 

FLDOOaaO 

N 

FtDOOASO 

FLOOOA60 

FLD00A70 

1 • 

FLnOOAAO 

MEAN(l)  = - * X * U 

FLDOOAQO 

N • 1 1 

FL000500 

• •• 

FLOOOblO 

1*1 

FLOO0S2O 

FLD00S30 

FLOOOS40 

• • 

FLDOOSSO 

*^TnEV(?)  s ••  C0VAR(2*2) 

FLOOOShO 

• 

FLOO0S70 

FLOOOSPO 

IN  3 0 

FLOOOSVO 

PTSl  s HTS 

FL(jO0t-00 

PT*;?  =PTS-1 

FU'00610 

IF  {PTs?  .LT.  1)  PTS2  ■ 1 

FLnC0(S?O 

N = NOrCAT 

FI nOONSO 

no  AO  jAsl.N 

FLOOOnAO 

J = JA 

FLO006S0 

no  in  K=i.j 

FLO  OflbhO 

,)K  = JK*1 

F Ln00<'70 

waP(.)K)  > (VAR(JK)-MEANU)*mEAN(K)/PTSI)/PTS2 

FLOOObMO 

rONT INUE 

F LDOOhSO 

nfVU  » a l)«;'iPT  (0A>1S(VAHUK)  ) ) 

Ftnoo/no 

FONT  lAltK 

FLOfloMO 

,tK  r n 

FLnOn 

no  sn  jsI.nofeat 

FLonn  no 

meanjj)  = vfan(J)/PTSI 

FLOno7AO 

no  sn  Ksi.j 

FLOOn  7S(i 

jK  s ,m  *1 

fldoo  nn 

roH(.iK)  3 o.n 

FL'H'O  1 to 

TF  (ME  V <«)  .nt  V ( J)  ,LI.  1.0E-,»S1  60  TO  SO 

FI no07«0 

fOI>(  JK)  s VAH(.JN)/(DtV(J)»nKV(K)  ) 

FU'OO  no 

r»r»r» 


FIL«^I  FLOCOV 


i 


?n 

lAft 

1?« 


no 


c 


4 


CONTINUE 


K 


F «G0  .§0,  0)  GFTURN 
JO  70  LOC«i.WOFEAT.l2 
STOP  a Lor*u 
tFISTOP  .r,T.  NOFf.*T) 


WPTTt  (Fn 


100) 

1001) 


( KFANCD* 
(OaSM 
« UtV 
(DASH 


STOP 


WPiTf  (<^ 

wPf  TF  (<S. } 10) 
wRiTFCc-.ianii 
WPTTF  <h.l20) 
fONTINUt 

F0OHAT(  *t:>4^AN!«,l2F9,2 
FOPMaT ( 1 At A4«A?/I 
format ( ‘OST  oev:»t  12F9 
FOPMaT(»0») 


a NOFFAT 
LOCtSTOP) 


LOC.STOP) 


) 


>2  ) 


w«lTF(<Stno) 
format  (•')•  / 
cau.  nw«‘- 

IF  (NOFE 
WRITE 


. OASM,  lal 
rOVARlANCF 


tS) 

matrix* 


I , • , - 1 V I aniv,c.  I K I » 

nwPTMx (VARtNOFFATtBCOTRO) 
OFEAT.I.  F.MaxFET)  60  TO  UO 

(htMEAD) 


/ lXtAA4tA2  ) 


WRTTF  IF^t  ISO)  < OASM.  laltS) 

FOPHAT(  iHj  //t  correlation  MATRIX*  /IXtOAA  ) 

CALL  OWRfMX (COHtWOFEAT.fiCOTWO)  , 

return 


ENTRY  rLSCO'/(C0KtnEVtMEAN,VARtPTS»60t 
•TITl F .NOFF aT.MAXFFT.VARSIZ) 

IF  (GO.FO.O)  60  TO  20 
WRITE  (^.mEAO) 

WRIT*- (^.  1 r>)  NOF*  AT 

WHITE  !4.  Jt,(l)  TITLE  t (OaSHtlaltS) 

160  FORMAT  (T47. 'THAlNlsr,  SUBCLASS  * tA*/TAftt4AA.  A2) 
60  TO  ?(i 
FNO 


FL000800 

FL000810 

FL000820 

FLOCCH30 

FLDOOeAO 

FL0008SO 

FLOOOReiO 

FLOOOeTQ 

FLOOoeeo 

FLD00690 

FL000900 

FL0009i0 

FLD00920 

FL000930 

FL000940 

FL0009SO 

FL000960 

FL000970 

FL0009RO 

FLO009R0 

FlOOIOOO 

FLOOlOlO 


floo 

FLOO 

FLOO 

FLDO 


020 

o3o 

OAO 

OSO 


FL001060 

FL001070 

FLOOIOMO 

flooioro 

FLDOI 100 

•FLCO 

FLOO 
FLOOll JO 
FLDOI 140 
FLOOl ISO 

FLOO 

FLOO 
FLOOlnO 


\\n 


floo 

FLOO 


ms 

n 

n 


OO 

00 


FL001210 


ooooooo  o o oo  o oooo 


FILE  LEAKN 


SUBKUUT  InE  LEAKmI  SPEC « CUV  AK  t A VaK  t CL^Ub:»t  ^UoSAVt 

* FLDMENtFL0VAK,Synht(Vf6Ub  VAK.SUtJSTO, 

* >UBCLS*HFTALyt«ifALYfFLUbAV»bAVEKT,KEFFTb,MAAiUb) 

IMFLU.  .T  JNTEOEKIA-Zl 
REAL  AbCALE fX^MFT, 

* COVAKlVAHblZIf  AVAKlNUFEATfMAAiUb)  »iUbSTU((VOFEAT,  MAXSUbl 
OUUbLt  FKtCiilUN  FLUMENiNOF  EAT)  , FLUVAKI  VAkS  lA  ) » iUbMEMNOFEAT  ) f 

* SUbVAK(VAK:>!A)  ,CUK(<tb5)»UEV(3U) 

INCLUDE  CUMbK<»,LI  ST 
INCLUDE  CUMbKbfLiST 
INCLUDE  CUMbKb.LlST 

OlMENblUiY  hEUl  U!>)fHED2(  15)tUATE(  3)  iCUrtENl  1 1 iJ  ) 

6 UUI VALENCE  (HEUK 1) ,hEAO( a) I, ( UAl E( 1 ) t HEAD! 22 ) ) t 
2 (H  I2{  1 ) fMEAUl  30  ) ) f (CuienT  i 1)  iHEaUI  Ab)  ) 

COMMUN/ULObAL/  E r[)  (6T  ) fMAHTAF,  DATAHEtbAVTAFtbhFlLE.bMKEY, 

1‘!  i-lL  *i-ll  SKE  Y t TKFuKH,  EKl  eT  R,  EKHAE  Y,  f-iAHUNT  ,NuF  ILE  f 

* UKUNAUtUKEr  ..i  ,EA ‘ SIZ*DATFiLtSTAHLiAi>AVtASAvFu 

* tNHbTUNtNHSTFi  ,;.CTi  UN,MAFFIL 

* f UUTUNI  .UUTFIL  5 UCHEASt  TRNSFL  tbhTKFL  »fi  ISTFLt  FCHUNT  t 
cru'jnt  iFktunt.kanuiu 

STAT  CDMHUN  bLUCK 

COMMON  /bTb  ASE/bUBSVlt  SUbMNl f SUbVKi t SUbSUl t SUdCLl ,SA VEKl , HS TaL I , 

A b EEC  I »CUVAKi , AV AK I f CLbl 01 tELMENl t FL VAK if  HeTALI»FLUS VI 
COMMUn  /bTCbLK,/  MAXFET.  MAAOLb  f MA  AFLUf  NuFEaT  |NUFET2  f 

* VAKb  1 2 fNUbEEC  ,NUM  1 ST  fSECbAbf  I b U CM  30  ) i FE  I V EC  ( 3U  ) t 
*FET  VC2  ( 3u  1 fM  IS  VEU  30  ) f NUFLUf  f>iUCLbf 

* FLDlNE(6)fFLUFTSfCLSRTSfXSl2fAtn,fitXLOWtYSIZ 


SEND 


DIMCNIjION  LmIST(30)  iVEkTCS(2f  li)fFL(b) 

UlMENblUN  SEECi  b,tMUSP.tC  ) fFLUSA  V(  iu  , MA  AEL  U ) , CLSDES  ( MA  XSUb  ) t 
A HFTaLY  (nUHIST  fXbU  ) ,MSTaLY(  i'jUhlb  r,AbIZ  ) tAEFHTSI  MAXSUb)  t 
A 1 DA  Ta  ( iiiu  UU  ) fOU.'iPTK  ( 5 ) * SUbSA  V(  At  MAASUb)  t 
AbAVERT(22  ,hAXFLU),bUbCLS(  I ) t SUo UeS i 500 ) 


EOUIVaLEnCE  (LHlbTf DESTVC 
EWUlVALEuCE  (ibLUCKI 

* ( IbLUCK ( 3) f SbFKEY 

» ( i L'LO:  K(  5 ) »H 

* (IeLUCK(7), 

A (IbUJCKi 

5 (I  BLOCK ( 

6 (IbLUCKi 

7 (1  BLOCK' 

b (IBLUCKI 

EUUIVALENCE  ( IDA r« ( 1 ) tCUK 
EOUiVALENCE  (FlOInFII 

1 (FlDTnF(3 

2 (FLDInF(5 

3 (FLU iNF ( 7 


) 

1 ) fNUTMNO  ) 
) t ( 1 BLOCK ( A 
SBKEY  ),  (IbL 
SSLKEY  ),  (lb 
y ) t NOTrib  2 ) 
1 1) ,EC  FuKY  ) 
I 3) t TbTKEY  ; 
15 ) , ThkskY  ) 
17 ) f ECALKY  ) 
( 1)  ) 

) t L 1 Nb  Tk  ) t 
) t L I Oi  NL  ) f 

) T Sam  END) t ( 

) fFLDi ye ) 


t (IbLuCKi  2)t  PCHKEY)  , 
) fCFUKEY  ) t 
UCK( O) f HFUKEY) , 

Lock ( b ) f sFDk  EY ) t 
f ( ibLUCK( 10)t  CALKEY)  t 
f ( 1 BLOCK! 12) f FCCLKY ) , 
f ( i BLOCK ( lA)f  TKnKEY)  , 
, (iBLuCf.(lb)fbTATKY), 


( FLUlNF(2)tLlNENu)  t 
( FLU1imF(  A)  t SAMSTk)  t 
FL  Dl  i<<E  ! 6)  f SaM  INC  ) f 


DATA  EnDcKO/ ' SEnU' / tOOMPTK/ 1 i 3*0? 1/ f UAb  h/  ' ' / i 

* blank/'  '/fUEAK/' (' /fCPAK/' )'/, comma/' PUNCh/7/ 


LEAOUUiU 
LEAUO020 
L EAU0U3U 
LEAOOOAU 
L EA0U05U 
LEAOOOoO 
L EAOOO/U 
LEAOOObU 
L EAUOOVO 
LEAOUlOU 
LEAOUllO 
LEA0U12U 
LEA0U13U 
LEAOUltO 
L EA00150 
LeaooIbo 

L EAOOr/O 
LEaUOIBU 
L EaOU  lYU 
LEAUOZoO 
L EA00210 
LEA00220 
L EAOU23U 
LEA002AU 
L EAOU250 
LE AU02b0 
LEA0U2/U 
LcaOU2oU 
L EAUU2VU 
LEAU03UU 
LEA0U3iU 
LEM00320 
L EAUU33U 
LEAUU3A0 
L caOu3bO 
LEA0U30U 
L EAU03/0 
LEAU03b0 
L EAOU3yO 
LEaOUAuO 
L EAUUAiO 
LEA0UA20 
L EA0UA3U 
LEAOOAAU 
L EA00A5U 
LEAOOAoO 
L EAOUA )U 
LEAUOAOU 
L EAOOAyO 
LEAUU500 
L b AU05 10 
LEaoU:20 
L EAOUtBO 
LEAOUbAO 
L EAOU55U 
LE AOObnU 
■L  EA0U5  10 


INIZ 


C*  SET  UP  LOOlCAL  ARRAY  FUR  FcATUKEb 
bUBNU=0 

00  I l=l,NUilIbT 
00  5 J =1 .NUFEA  T 

1F(  HliVbCd  ).EO.FETVEC(  J)  )GU  Tu  O 

5 CONTINUE 

6 LHlbT ( 1 )=J 

7 CONTINUE 

00  V22  1 =1 fMAXbUb 
V22  bUbCLb ( 1 )=0 

C*  READ  MEAUEK  KECOKU  ON  DATA  TAPE 
CALL  TaPmuk  (UATaPE  f()A  TF  I L > 

REklND  ShVTaP 

1 F ( bTAE  i L .EO.U  ) Oil  TO  5A  1 

CALL  FbobFL(bAVrAPrb)AFlLfNbrAl) 

1 F ( Nb  T A T . E (J  »0  ) OU  iu  5A  1 
write  (bt5A2  ) Nb  lAT 


LEA00500 

L EAUUbyU 
LE AUUboU 

L EAU0610 

LE AUOb/0 

Iu  Bb  HISTOORAMMEU.  LEAOU6JO 

Lb AUUBAU 
L EAOObbU 
L E AUUOBU 
L EAUU6/0 
LE AUUboO 
L EAUut.yO 
Le auu7uo 
L EAUU  / lU 
LEa(JU7/U 
L EAU073U 
LEAUU/'tO 
L EAOU  /DU 
LL AOU  700 
I.  EAUU  / lO 
Le  AUU  /i)U 

L EAUU  7yu 


f 


FILE  LEAKN 


5A2  FOKMATC  BAU  HOidTiUNiNG  UF  SAVTaH,  TEKMINaTING  *tI3) 
CALL  CKEKK 

5Al  continue 

CALSW  = CALKEY 
bAOFLG  = U 
NUFLU  =0 
NOCLS  = U 

10  CONTINUE 
WKITE  ib.HEAU) 

IF(HboKEy+HFOKEY.Ey.O)  GO  TO  14 
XSCALE=»-LtJAT(l-Ai  I / ) / (XHUH-XLUH) 

XSHFT=-XhOh*XbCALE+1.0 

00  2U  1 =1  ,XbiZ 
DU  20  J=1 tNUMlST 

20  MFTAL Y (J  , 1 ) = 0 

lFlHl>o^EY+MFDKEY.^E.2)  GO  TO  14 
DO  3U  1=1  ,XbIZ 
DO  30  J = 1 .NUHIST 
30  HSTALYIj ,1 )=0 
GO  TU  14 
C CLASSES 

11  KEAD(30,12)  TITLE 

12  FORMAT! lux, a4) 

REWIND  3U 
N0CLS=MjLLS+1 
CLSTUT  =nuCLS 
CLSDtS (nulls )=T1TLE 
GO  TU  l<» 

C SUdCLASShS 

13  REAU(3u,12)  TITLE 
REWIND  3u 
SUbNU=SUttNO+l 

1F(  SUDlsiU.GT.MAXSUB)  GO  TO  490 

SCL  fur  =1>UUNU 

SUOSA  V ( A tSUbNU)  =T  I Tu  E 

c starting  field 

SUbSA  V (/;  .SUtiNU)  = NQFLD  + 1 
SUttSAV  ( 1 iSUblMU  )=NOCLS 
SUbCLS  (nulls  )=SuaOLS(l\lOCLS)+l 
C READ  FIELD  CakD 

14  CFLa(j  = L akEA  u I FL  UNAH  f VER  TCS  jFLUlNFt  NC  ) 

C End  I CLASS,  AND  SUbCLASS 

IF  (CFlag  .eu.  u)  gu  to  faO 
IF  (CFLAG  .eD.  -i)  GU  TO  11 
IF  (CFLAo  .EU.  -2 ) GU  TO  13 
N0FLD=nUFLD+1 

1F(  Nt.iFLD.GT.MAXFLD)  GU  TO  SIO 
FLDSav ( 1 ,NUFLD )=FLUNAM 
FLDSa  V (2  , NUFLU)  =n(jLuS 
FLDSav ( 3,NUELD)=SUbNU 
FLDSa V (4 ,NUFLD) =NC 
FLDSav! S , n UFL D ) = L 1 NS TR 
F L OS  a V ( b , N UF  L U ) = L I N E NU 
FLDSav  ( / ,NLjFLD)  = SAhSTR 
FLDSA  V { b ,nUFLU)  =->  AMEND 
FLDSAV ( 9 ,NUELU ) = LIn INC 
FLDS/»V  ( ID  ,UUFLD  ) = SAMInC 
SUbSAV ( s ,SUbNU ) = nUFLD 
K.  = 0 

DU  111  J=l,il 
DU  1 1 1 1=1 ,2 
R = K+  1 

111  SAVekT (n ,NUFLU) =VERTCS(  I , J ) 

TOTVkT  =TuTVrT+NC 
GU  r U 14 

60  C ON  T I NU  E 

WRITEISAVTAR)  NULLS, SUENU ,NUFEaT , NUFLU, TUlVRT,(FETVhC( i 
vT) 

DO  fal  1=1  ,NUFLD 
TNC  = 2=:-FLUSAV(4 ,1  ) 

WRII E (SaV)AR)  I FLDSAV (J,1 ) , J=1 ,4) 

61  WR I TE( SA VTAF  ) (S aVE RT ( J , 1 ) , J=  1 , TnC ) 

write(savtaf)(Cl>dls(j), j=i,nugls ) , ( SUbCLS ( J) ,J=i ,nucl; 

* 1 Slj  b SA  V ( 4 , J ) , J = 1 , S UB  NU  ) 

1 F(  PCMRE  Y .NE  .1  ) GU  TU  62 
WR  I TE I FUnuN I , o3 ) 

63  FUKM/l  1 ( ' mUUULE  TRAlNiNl,  FIELD  UEbR') 

WR  n h ( FGhUN  r ,64  ) NULLS  , SUbNU  , I'lJ  EE  A I , NUEL  D , T Ul  V R T 

',12,'  nUFEaI  *,12,'  NuFLU 


64  FUKMA T I ' nulls  ',14,'  NUSUb 


LEAUU6U0 
LEmOOUIO 
LEAUUy20 
LEAUOaiU 
LEAUUtt40 
LEAOOUSU 
LEAOUtibU 
Lt AUOb /U 
LEAOUUttU 
LEAUUB90 
L tAOOVuO 
LEA00910 
LEAU0920 
LEA00930 
L EA00940 
LEaUO9S0 
LtAOU9bO 
LEAUU970 
LtAOOVbO 
LtAUU990 
LEAOIOOO 
LEaOIOIO 
LEA01020 
Lead  1030 
L EA01040 
LEA01030 
L EAU  lObO 
LEaOIO/U 
L EAUlOBO 
lead  1090 
LEAUllOO 
LeaO  11  10 
LEAU1120 
LEAD  1130 
L EAO  1 140 
Lead  1 1 so 
L EAO 1160 
LEAO  1 1 /U 
L EAU  1 IbO 
LEaU  1190 
LEA012U0 
LEAU  1210 
L EA0122U 
LEA01230 
L EAU1240 
LEAU12S0 
L EAul2oO 
LEAU  12/0 
LEA01200 
lead  1290 
L EAOl 3uu 
LEaU  1310 
LEA01320 
Lead  1330 

LEAO 1340 
LEaU  13  so 
L Eao 1 3bU 
LEaU  13  /O 
LEAUlSbO 
LEaU  1390 
L EAU 14UU 
lead  141U 
L EaU 14  2U 
LEaU  1430 
L EaU 1440 
LcaU  14SU 
, 1 = 1 , N U F E At  E aU  1 4 OU 
LeaO  14  /O 
L EAU  14bU 
LEAU  1490 
LEaU 1 SUO 
LEmU  ISlU 
, LEaU IS  20 

LEaU  1S3U 
LEAU1S40 
LEAU  ISbU 
L E AU 1 Sou 
LE AU  lb  / u 
,13,  L EAU  Ibou 


/ ‘ , i 


FILE 


LEAKN 


* ' TUTVKT  SlA) 
WRITE(FthUNTtl65) 


. (FETVECd  If  I»lfMUFEAT) 

165  FORMAT  ( 'ChnvEC  f<fX, 3012) 

DO  65  l=lfNUFLO 

WKlTb  (FCnuMf66)  (FlOSAVI  Jf  I If  J=lf  <f) 

66  FOK MAT ( f 6 A f i 2 ff 6X f 1 2 f 6X f 1 2 I 
TNC»2>^FLU5AVUf  1 1 

' “ (SAVEKTI Jf I I f J = lf TnC) 

' tlA15) 

(CLSaESU)tJ  = l»MUt^t-!>> 

• f9i2x,AA  I ) : 

(SUHCLSI Jit J=1 tNUCLS) 
f2A(  1X,12III 
( SUbSAV (At J I t J^lt 6UDNUI 
• tlUCAAtlXlII 


65 
67 

66 

69 

90 

62 


INC 


WKlTfe( HLHUNT  t67I 
FORMAT ( • VtRT lLt6 
WR1TE( HChUNTt6bI 
FORMAT ( ( 'CL5UE5 
WRlTb( HChUNT  t69I 
FORMAT ( ( 'bObNO 
WRlTb(HCM0NTt90l 
FORMAT ( ( • bObOES 
CONT  li'JUt 

MRlTb(6tAll  (0A5rltI  = lt20I 
00  AO  K.=  l fNUFLD 
JJ=2A(FLU5A V(AtXI-lI 
MP=FLUSAV(2tR I 
KJ  = lU 

IF(JJ.LE.10I  KJ=JJ 
MPP=FL05AV(3tRl 

WRlTt(b tA2  I K,FLOSAV( ItKl tCLS0t5(MR I t50bSAV( AtMHPI tFLD5AV( 

♦ FLDSAV (9 tK  I f ( (OP«K  f SAVERTC I tKI t C UMMA t 5A Vt RT ( i+ 1 , K ) , C PakI  1 1 
IF( JJ.Lh.iOI  bU  TO  2017 

WRlTt(6,A3I  ((0PARtSAVERT(ItKl,C0MMAt5AVhKT(  l+ltKI,CPAR)  tl 

• I 

2017  continue 

A2  FORMATIAA  t lAt2XtAAtAXt AA.AXtAA, 5A 1 1 At 3Xt 1 At AXt 
=!'5(  Al  , lAtAl  , lAtAi,2X  1 I 
A3  FORMAT ( bOAt5(A  1, I A t A 1 1 I A t A 1 1 2X I I 

AO  continue 

A1  format  (//T50f  • TRAInINO  F I EL  DS  • / TA9  t ‘tA  A/ / 

'S'TX,  *F  IeLU' tT3b, 'j  AMPLE  Lll'*:'/ 

>»=5X  f 'NO.  NAME  ' lAXf  ' CLASS'  t 3X  f ' bUbCLASS 
»AX vert 1CE6 ( SAMPLE  tLlNEl • / 

■»AX  t 3aA  ,2X  tAA  tA2, 2Xf  2AAt  IX  t 3AA  t AX  t bA'tt  A 1 I 
SUbNU=0 
SUbNU=SUbNU+l 
SUBPTS=0 

00  71  l=lfNUFEAT 
SUBMEN ( I I =0. 

DO  72  1 = 1,VaRSIZ 
SUBVAR ( i 1=0. 

FIEL01=SUbSAV(2tSUBN0l 
F 1 ELUL  =SUbSAV (3  ti  UbNU I 
00  301  N=FlELUltElELUL 
00  73  1=1 tNUFEAT 
FL0HEn(1I=0. 

DO  7A  I =1 t VARSI i 
FLOVAk( I )=0. 

LInSTK=FL0SAV(5 tNl 
L1NENU=FUUS AV (6tNl 
LIN1NC=FLUSAV(9 ,Nl 
SAMSTR=FLUS AV ( 7iNl 
SAMENU  = FLUSAV (B  fN  1 
SAM1NC=FLUSAV(  lU  )NI 
CALL  FLU  1 NT (FLO InF ,FE TVEC t NOFEaT I 
L1NES=( L InEnO-LI nSTR I/LIN1NC+ 1 
PTS= ( SAMENU-SAMSTR 1/SAMlNC+l 
NS AMP  =PTS 
FLUPTS=0 

00  17  JL 1NES  = 1 .L INES 
CALL  L INERO ( lOATA t ENOTAP 1 
IF(  ENDTaP.EW.- 1)  GL)  TO  16 
1F(  JL  INES.NE.I  1 00  TO  « 

NL  iNES  =L INSTR 
00  TO  9 

NL INES =NL INES+L INI NC 
CUNT INUE 
K = 0 

00  93  1 =1  f 11 
DO  93  J=i t2 
K = K + 1 

VERTCS(Jfl 1=SAVERT(K,NI 

call  FOL INI ( VEKTCS  f FLOSAV ( A, N I t FL  t NL 1 NES i NS t J J J I 
KK,=  0 
NN  = 1 


70 


71 

72 


73 

7A 


B 

9 


93 


LEA01590 
LEA01600 
LEA01610 
Lead  1620 
LEA01630 
LEA016A0 
LEAOlbbO 
LEAO  1660 
LEA016/U 
LEAO  16b0 
LEA01690 
LEA01700 
LEA01710 
LEA01720 
LEA01730 
LEA017A0 
LEA01750 
LEA01760 
LEA01770 
LEA017O0 
LEA01790 
LEAOiauO 
LeaOIBIO 
lOtKii  LEA01b20 
= ltK,J  f21LEA01630 
LEaOIBAO 
= 11 t JJ  t2LEA0lB50 
LEAO  IB60 
LEaOIB/O 
leaoibbo 

L EAUIB90 
LEAO 1900 
LEA01910 
LEA01920 
L EA01930 
LEAO  19A0 
L Ea01930 
LEAO I960 
LEAU1970 
LEAD  1960 
L EA01990 
LEA0  20U0 
LEA02U10 
LEAO  2020 
L EA0203U 
LEA020A0 
L EA02050 
LEAO 2060 
LEA02070 
LEAO 2060 
L EA02090 
LEAD  2100 
LEA02110 
LEA02120 
LEA02130 
LEAO  21AU 
LEA02160 
LEAU2160 
LEA02170 
Leau  2160 
L EAU2 190 
LEA022UU 
L EA02210 
LEA02220 
L EA02230 
LEA022A0 
L EA02250 
LEA02260 
L EAU22  ?U 
LEA0226U 
L EAU2290 
leau  2300 
LEAU231U 
LEAU  2320 
L EAU2  330 
LEA0  23AO 
L EA02  330 
LEAO  2360 
L Ea023^0 


M6" 


FILE  LEAKN 


KC=0 

DO  1 J=lfNUFEAT 
lNOtXlB( J-l)#NSAMP 
JJ  = J 
UU  3 

k K — K KA  1 

lNUEX2  = U-l)*NbAMP 

L=l 

DO  2 JPT»ltNi>AMP 

KPT=  <JPT-1  )*5>AM1  nC+SAMSTK 

DO  4 JK=LiJJJ*2 

1F(KPT  ,LT.Fl(  JM)  DO  TO  2 

1F(KPT.DT.FL(  J<  + n»  GO  TO  15 

IDJ= IDATA ( 1NDLX1+ JPT ) 

IF(J.tU.l)  >LUKl>  =FlUPTS+1 
IF(K.tU.i  ) >LUMtMJ»=FLDMbN(  J)+IUJ 
FLUVAkIKK  )=FLUVAK(KK)  + IOJ‘!'IOATa(  lNL)UX2+JPn 
IF(LHUT(NN).Nb.J)  GO  TO  2 
KC  = l 

1PUT=10ATA  (jHT  + lNDbXl)*XSCALb+XJ>hFT+0.501 

1F(  IPUT.LT.I)  1PUT=1 

1F( IPUT .DT.A512)  1PUT=XSIZ 

HFTALYINN. iPUl )=HFTALY(NNf IPOT)+l 

1F(  JPT.bW.NiAMP)  NN=MY+1 

GO  TO  2 

15  L=L+2 

1F(  L .GT.JJJ  ) DO  TO  53 
4 CONTiNUb 

2 CONTllYUb 

IF(  JPT  .bW.Ni.AMP)  GO  TO  3 
53  IFIKC.bW.l)  NN  = iMi^+l 
KC  = 0 

3 CONTiNUb 
1 CONTINUE 

17  CUNllNUb 

16  continue 

SUbPTS=SUbPi;i  + FLUPTS 
DU  2UU  l=lfNUFEAT 
200  SUbMENd  )=6UbMbN(  1 ) + FLDMbN(l  ) 

DO  21  I =1 ,V AK6 17 
21  iUbVAKd  )=SUbVAK(  1 ) + FLD  VARil  ) 

T I TLb  =i>Ub6A  V (4  ,6  0HNU  ) 

IF(  CFUAbY+6hUNbY(-HFUK.bY.t(J.O)  00  Tu  3U 1 
lF(CFUNbY+i.FORbY.bU.U)  GU  TO  2b  0 

CALL  FLUCUV  (COR  .Ub  V t F COM  bN  , FUU  VAK  , Fl  UP  f 6 , CFOn  E Y , FlDSAV(  1 »N  ) , 
*NOFLAT iMAXFlT , VaKSI Z ) 

C PLOT  SPfcCTKAL  KlGPunjE  FOK  FIELDS 
1F(  SFUK.bY.bw.0  ) 00  TU  270 

CALL  FLDSPC(FLUMbN»ObVtFl,DSA\/  ( 1,N)  ,UUMPfK,(  UaTA, 

“fFLDMEN  »FlUVak, TITLE*  ivUFbATfFETV  EL  iSPCbAS) 

270  1F(  HFDKbY .bW.O)  00  TU  301 
260  I F( USdKEY .bw.U  ) 00  TO  300 
DO  2 90  1 =1  ,AS IZ 
DO  2VU  J =1  *i*OH  IS  T 

2 90  HSTALYU  ,1  )=HSTaLY(  J*I  )+HFTALY  (J,I  J 

300  COlMTlNUh 

CALL  FLDhIS (HFT AL Y , 1 DATA ,FLOSA V(  i , N ) , XS 1 Z , X HOH  ,XL UW , YS I Z * 
-NOHIST.FLDPTS ,T ITLbthlSVbC) 

301  CONTINUE 

C calculate  CUVAK  MTX  and  mean  vector  fur  SUbCLASS 

CALL  CLSCUV  (COK  .06  V , SUbi-1  LN.SUb  VAr  * Sub  P T S * SS  Fr  E Y , 

'^T  1 TLE  fNUFEAT  fl■lAXFET  .VAKSI  Z ) 

C SAVE  SUbCLASS  MEAN*  CUVAR  , S TO  DEV 
130  DO  31  1=1 *N0FEAT 

AVAR  ( 1 *SObNU ) =SUbMEN ( I ) 

31  SUbSTUd  *SUbNU)  = UbVd  ) 

00  32  J=1 * VaKSI Z 

32  COVAR( J ) =SUbVAR( J ) 

KEPPTS (SUbNU ) = SUbP  TS 

C PLOT  SPECTRAL  RESPONSE  FUR  EACH  SUbCLASS 
1 F(  SSLKEY .EU.U)  OU  TU  33 

CALL  CLSSPC ( AVAR ( 1 *SUbNU ) * SUbSTU(  1 * SUbNU) * T ITLh*  DUMPTK* lUATA 
•xTITlE  fNUFEA  T *FeTVEO  *SPCbAS) 

C PRINT  SUbCLASS  HiST 

33  1 F(  HSbRE Y .Eu.O)  00  TU  390 
T 1 TLE  =SUbSA  V (4  *S  UbNU ) 

IF(  HFUNtY.EU.u)  00  TU  360 

call  CLSMl S (MS TaLY * lUA TA * T1 TLE  * X i 1 Z * X hoH , XL UW * YS 1 Z * 

■'NUHI  S T*FUjP1S,m1'>VeC) 


LEA02360 
LEAO2390 
LEAU2400 
LEM024  1 0 
LEA02420 
LLA02430 
LEA02440 
LEA02450 
L EA02460 
LEA02470 
LEA02460 
LEA02490 
LEAO25U0 
LEA02510 
LEA02520 
LEA02530 
LEA02540 
LEAU2550 
L EA02560 
LEA02570 
L EAU2560 
LEA02590 
L EA02600 
LEa02610 
L EAO2620 
LEA02630 
L tAU2640 
LEA02650 
LEA02660 
LEAU2670 
L EAU2660 
LEA02690 
L EA027U0 
LEA02710 
L EAU2720 
Leau  2730 
Lea02740 
LEA02750 
L EA02760 
LEA027ZO 
L Eau2  ZbO 
LEA02790 
L EA02600 
LEAU  26  10 
LEA02820 
LEA02630 
L EA02640 
LEA026b0 
L EAU2660 
LEA02670 
L EA02660 
LEA0  26  9 0 
L EA02900 
LEAU2910 
L EA02920 
LEAO  2930 
L EAU2940 
LEAU295U 
L EA029O0 
LEAU2970 
L EAU29O0 
LEAU2990 
L EA030U0 
LEA03010 
L EA03020 
LEAU3U30 
L EA03040 
LEA03030 
L EAU3060 
LEA030ZO 
L EAU  3UO0 
LE AU3090 
L La031u0 
L E />  U 3 1 1 0 
L EAU3120 
LEAU3130 
L EAU3140 
lead  3 ISO 
L EAU3160 


noon  oooo 


FILE 


LEAKN 


tXHbH,  XLUMtVSIZt 


GO  TO  3 VO 

3H0  CALL  CLS>hlS(HFTALYf  IDA  TA, title 
*NUHlSTfFLOMT!»  fHl>  VtC) 

390  WRITE(^AVTAH)  Kt FPTS ( SUBNO ) t ( CUVAK (1 ) t 1 =1 , VA KS U ) t 
* ( AVAKI  1 iSUbNU)  NUPEaT) 

IF(MCMKEY.Nt.l  ) GO  TO  V<» 

WRITE (PCHUNT, 95)  KEPFTS ( SUBNO) 

95  F0RMaT( 'NUPTS  SbXflB) 

write (PCHUNT«96)  I AVAR! I tSUBNU)i IsltNUFEAT) 

96  FORMAT!  'MEAN5*  .5E15.B)  , 

WRITE (PCMUNTfV?)  (C UVAK ( I) i I »1 , VARSI Z ) 

97  FORMAT! 'CUVAK' f5E15.B) 

9<r  1F(  SUBNU.lt. 5CL TUT)  GO  TO  70 
ENDFILE  SAVTAP 
REWIND  SAVTAP 

PUBLISH  THE  MULT  I SPECTRAL  PLOTS 


AlO 

IF 

(SPEC! 

JK 

= U 

00 

ABO 

1 - 

DO 

A2U 

J = 

11  = 

I 

JJ  = 

J 

JK 

= JK+  1 

SPECU 

,I  ) 

IF( 

JK. 

EU. 

A20 

CONTINUE 

ABU 

SPE 

C(5 

,I  ) 

AAO 

SPEC ( 5 

,11 

NOS 

PEC 

= 11 

A50 

continue 

DU 

ABO 

1 = 

GO  TO  A50 


.NOS  PEC 

.A 


= JK 


GO  TO  4A0 


GU  TO 


.NUSPEC 
K = SPEC!5,1) 

JJ  = U 

DO  <tbO  J = 1 ,iL 
I F( bRtC IJ . I ) .GT.SUBNU) 

JJ  = JJ  -^1 
SPEC (JJ ,I  ) = SPEC! J. I ) 

^60  CONTI  NOE 

IF  (JJ .Ey.O)  GO  TO  ABO 
SPEC(S.l)  = JJ 
WRITE  (6, HEAD) 

WRl  TE  (tj.AbS) 

Ab5  FORMAT!//  27X , 'COMPOSI TE  SPECTRAL  PLOT  !MtAN.PLUS  AND  MINUS  UNE 
ID.  DEV.  ) FUR  ' / ) 

WklTt  (b,AVu)(SPEC(J.I  ),J=1.JJ) 

A70  FURMAT(3bX, 'TRAINING  SUUCLASSIES)  '.AIA/AIX.' 

DO  9B  J I=l .bUbNU 
9B  SUliDES  !J  1 )=SUbSAV  ! A,  J1  ) 

JK  JJ  .LT.  A)  WKITE(6,A71)  ! DASH, 11=1, 5 
A71  FURMaT(A1X,AAA,A2  / ) 

CALL  HULSPC ( AVAR (1,1 ) ,SUBSTO( 1, 1 ) , SUBUES , S PEC ! 1, 

»NUFEAT ,FET VEC.SPCBAS) 

ABO  CUNT INUE 

CALL  bETMRGlfab,A,62) 

return 


) 


1)  ,IOATA, 


ERROR  routines 


A90 


BADFLG  = 2 

WRirE(b,500)  MAXSUB .MAXSUB 
500  FORMAT (//5X, STAT/LEARNN  Max  NO.  UF',lB,3x, 

■t- FEU  ED FIRST  ' ,1B,3X  , ' SOBCL  ASSES  USED — KEMA  InUER 

(,0  TU  53u 


• subclasses 

IGNORED' ///  ) 


510 


BADFLG  = 1 
WR  I Te(  6 ,52  0) 


HAXFLD.MAXFLD, SUBNO 


520  FORMAT!////  SX, 'vf***:  STAT/LEARNN MAX.  UF',lB,3X, 

1 'FlELUS  EXCEEDED ' , I B , 3X , ' FI  EL  US  RETAINED  F0R',lB,3X, 

‘xisubclasses'/5x,'>»*=>hemainoer  of  iivuT  Training  fielus  not 

530  READ  (21,5AO)l 
5A0  FORMAT  (AA) 

IF  ( I .NE .ENUCRO ) GO  TU  530 
GO  TO  bU 


LEAU3I70 
LEAU31B0 
LEAU3I9U 
LEAU32UO 
LEA03210 
LEAU322U 
LEAU3230 
LEAU32AU 
LEA03250 
LEAU3260 
LEA03270 
LEAU32BO 
LEAU329U 
LEAU33U0 
LEA03310 
LEA03320 
LEA03330 

LEA033A0 

L EAU3350 
LEAU3360 
LEA03370 
LEAU33B0 
L EA03390 
LEAU3AUU 
LEA03A10 
LEA03A20 
L EA03A30 
LEA03AA0 
L EA03A50 
LEA03A60 
LEAU3A70 
LEAU3AB0 
L EA03AV0 
LEA035U0 
LEA03510 
LEA03520 
LEA03530 
LEAU35A0 
L EAU3550 
LEAU35bO 
LEA036/0 
LEA035B0 
L EA03590 
LEA03600 
L EA03610 
S (LEAU3620 
L EA03b30 
LEA036A0 
•/  )LEA03b50 
LEAU3boO 
LEA03b70 
LEAU36B0 
L EA03bV0 
LEAU37U0 
LEA03710 
LEA03720 
L EAU3730 
LEAU37A0 
L EA03750 
LEAU37bO 

L Ea037  /0 

LEA037B0 
LEA037V0 
LEA03BU0 
XECLEA03B10 
LEAU3B^U 
L EAU3BJ0 
LEA03BA0 
L EA03B50 
LEAOiBbO 
L Ea03b  /O 
LE AUibbO 
USED  '/  )1.  EauJbvO 
LE AU3VUU 
L EAU3V  10 
LEAU3V20 
L EAU3V30 

Leaujvau 
L EA03950 


FILE  LEAKN 


file:  SETUPl 


8* 


V 

I 


SUBROUTINE  SETUPl (SPCVECtTOPiM«XSUB) 

PURPOSE*.  READS  AND  ANALYZES  SUPERVISOR  CONTROL  CAROS 
FOR  THE  'STATISTICS*  STEP 

IHPLICIT  integer  (A-H.O-Z) 

DIMENSION  SINVECO)*  SPCVEC (5^?0)  ♦ CAR03 (6?)  tNUMVEC « 30) 
DIMENSION  CINOEX(13) t0PTC00(6) ,EQUVEC(2) fACAR0(20) 

INCLUDE  C0HRK4 
INCLUDE  COMbK6»LIST 
INCLUDE  C0MHK«,LIST 

DIMENSION  mEDI « IS) tMEDa (15» .OATE ( 3) .COMENT ( IS) 

EQUIVALENCE  (HEOl ( 1 ) «HEA0(4) ) » (DATE ( 1 ) tHEAD (22) ) * 

2 (HED2(1) »HEAD(30) ) , (COMENT ( 1 ) * HEAD (48) ) 

C0MM0N/GL0dAL/HEAD(63) »MAPTAP.nATAPE»SAVTAP»8MFILE*BMKEY» 


HISFIL»HISKEY.TRFoRM»ERIPTP»ERPKEY,MAPUNT, NOFILE. 

* ORUMAO.ORMWOS.PAGSIZ.DATFIl.STAFIL.ASAV.ASAVFL 

* .NHSTUN.NHSTFI.SCTRUN.MAPFIL 

* .DOTUNT.OOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

* CROUNT.PHTUNT.RANOIO 
STAT  COMMON  BLOCK 

COMMON  /STUASE/SUBSVl .SUBMNl .SllBVRl .SUBSOl .SUBCLl .SAVERl .HSTALl » 
•SPECl.COyAHI.AVAHl.CLSIOl.FLMENl.FLVARl.HFTALl.FLOSVl 
COMMON  /STCBLK/  MAXFET.MaXCLS.MAXFLD.NOFEAT.nOFETZ. 


CSEND 


•VARSIZ.NOSPEC.NOHIST.SPCBAS.IBLOCKOO)  .FETVECOO)  . 
•FETVC2O0)  .HISVECOO)  .NOFLD.NOrLS. 

• FL0INF(6)  »FL0PTS.CLSPTS.XSl7.XHGH.XL0i<.YSIZ 


ECJUIVALENCE 


C 

C 


« 

4 

5 

6 

7 

8 


(I BLOCK 


(IBL0CK(  D.NOTHNG) . (IHL0CK(  Z).PCHKEY). 


CKO)  .SSFKEY)  » (IBLOCK(4)  .CFOKEY)  . 

( IHLOCK (5) .HSBKEY) . ( I8LOCK (6) .HFOKEY) . 
(IBLOCK(7) . SSLKEy) . (IBL0CK(8) .SFOKEY) ♦ 

(IBLOCK(  9).N0TH02). ( I BLOCK ( 1 0) » CALKEY) » 
(IBLOCK(ll) .PcFOKY) . (IHLOCK (12) .PCCLKY) . 
(iHL0CK(13) .TSTKEY)  - - - - 

(IHLOCK(IS) .ThRSKY) 

(I8L0CK(17) .PCALKY) 


(i BLOCK { 14) .THNKFY) , 
(IRLOCK(16) .STATKY) . 


DATA 

DATA 


1 

1 

3 


SlNVEC/2.'.'  . **•  / . E0UAL/*='  /.  BLANK/  » * / 

C8C0/'C'/.F8C0/'F'/.LBC0/'L'/.SBCD/'S'/.XriC0/'X*/, 
YBCD/'Y'/.BLANK/'  '/.HRCO/iH'/ 
♦NBCD/»N»/.OBCO/'0»/»ABCO/'A*/ 

.UBCO/'U'/ 


C 

C 

C 

C 

C* 

C* 

C* 


DATA  C1NMAX/13/.E0UVEC/1.'='/ 

DATA  OPTCOO/'M'.'P'.'C'.'H'.'S'/ 

DATA  CINOEX/ 'OPTI • . * CHAN« , • HIST • » 'SPEC*  » • IBLO* . 

1 'SIZE '» 'DATE* .'*ENO», 'COMM*. 

2*HE01'»*HE02*  . 'DATA *. 'STAT •/ 

INIZ 

READ  AND  UNPACK  HEADER  RECORD  TO  SET  MAXFET  ACCORDING  TO  ID(S) 

I DO  2 1=1.30 
FETVEC(I)  = I 
HISVEC(I)  = I 
? IBLOCK(I)  = 0 
N8L0CK  = 0 
CALKEY  =0 
CCLKEY  = 1 
MAXCLS  = IS 
MAXSU8=15 
MAXFET=30 
SYHMAX=30 
NOSPEC  = 0 
SPC8AS  = 75 
YSIZ  = 14 
XSIZ=0 
XLOW=120 
XHGH=220 
INFMT  = 0 
NOFEAT=0 


SETOOOlO 
SCT00020 
1SET00030 
1SET00040 
SETOOOSO 
SET00060 
SET00070 
SETOOOSO 
SET00090 
ISETOOIOO 
SETOOllO 
SET00120 
SET00130 
SET00140 
SET00150 
SET00160 
SET00170 
SETOOlSU 
SETOOIRO 
SET00200 
SET00210 
SET00220 
SET00230 
SET00240 
SET00250 
SET002B0 
SET00270 
SET00280 
SET00290 
SET00300 
SET00310 
SET00320 
SET00330 
SET00340 
SET003S0 
SET003ft0 
SET00370 
SET00380 
SET00390 
SET00400 
SET00410 
SET00420 
SET00430 
SET00440 
SET00450 
SET004ft0 
SET00470 
SET00480 
StT00490 
SET00500 
SETOOSIO 
StT00520 
SET00530 
StT00540 
SET00550 
SETOOB60 
SET00670 
SET00580 
SETOOSRO 
StTOObOO 
SETOO&IO 
SETOObZO 
SET00630 
SET00640 
SETOObSO 
SET00660 
SET00670 
SETOObbO 
SETOObPO 
SETOO  (00 
SET00710 
SET00720 
SET00730 
SET00740 
SE  rn07S0 
SET007bO 
Sk  T00770 
SET00740 
SET007R0 


onoo  o oor»r*or»oo 


FILE*  SETUPl 


READ  AND  ANALYZE  SUPERVISOR  CONTROL  CAROS 


SETUP  REREAD  BUFFER 

CALL  REREAOOOvBO) 

200  COL  s 0 

NOW  READ  THE  CARO  INTO  THE  BUFFeP 
READ<2Ulb0)  (ACAKO(I)  ilsl*20) 

ISO  FORMATlaOAA) 

WRITE00.150)  (ACAROm  »lal»20) 

REWIND  30 

READ<30«2002)  CODEtCAROZ 
2002  format  (A4t6X»62Al) 

REWIND  30 

225  WRITE(6f2252)  C00E.CAR02 
22S2  FORMAT  < TSt AAt 6Xt 62A1 ) 

DO  230  IsltClNMAX 

IF  (CINOEX(I)  .EO.  CODE)  ^ 

1 GO  TO(lU>600*700*eOO*1100tl200*lAOOt900*1500tl600» 

2 1700tl710tl720) »I 
230  CONTINUE 

GO  TO  1000 


OPTION  CARO 


10 


M = NXTCHR(CAR02fC0L) 

IF(M  ,EO.  bLANK  ) GO  TO  200 
IF(  M ,E0,  0PTC00<1)  ) GO  TO 
5ETFLG  * I 

IF  ( M .NE.  NBCO  ) GOTO  lA 
J = COL-1 

M = NXTCMR(CAR02.C0L) 

IF  (M  ,NE.  OBCO  ) GOTO  12 
SETFLG  = 0 
J = COL 


20 


12 

14 

15 

40 

402 

1 


COL  = J 

M = NXTCHR(CAR02.C0L) 

DO  15  1=2*5 

IF(  M .£Q.  ORTCOO(I)  ) 60  TO  ( 40 . 30 * 25 • 30 » 30 ) * I 

CONTINUE 

IF(  M ,EQ.  BLANK)  60  TO  200 
M = COL  ♦ 10 
WR1TF(6.402)  H 
FORMAT(/  IX.****  STAT/5ETUP1 
CAN  OF  OPT  ION (S)  discontinued 
GO  TO  200 


ERROR  IN  OPTION(S)  REQUESTED 
aT  card  column* . I5.2X* •*•*•  /) 


20  M = FIN012(CARD2.C0L*5INVEC) 

IF  ( SINVEC(M)  .NE.  EQUAL  ) GO  TO  40 
M = NUMUEH (CAR02.C0L.NUMVEC.29) 

IF(  NUMVEC(IO)  .LE.  0)  GO  TO  4O 
MAXSUH=NU.-(VEC(30) 

GO  TO  10 

25  J = 20 

M = NXTCHR (CARD2.C0L) 

IF  ( M .EQ.  OBCD  ) J=3 

IF  ( M .EQ.  AbCD  ) J=9 

IF  ( J .LT.  20  ) GOTO  32 
GOTO  40 

30  J = 1*2-3 

32  M = FIN012 (CAR02.C0L.5INVEC) 

IF  ( SINVEC(M)  .NE.  EQUAL  ) GOTO  38 
M = NXTCHR (CAR02. COL) 

IF  < M .EQ.  CbCO  ) IHLOCKU)  = SETFLG 

IF  ( M .EU.  FHCO  ) IHLOCK(J*l)  = SETFLG 

M = FIND12 (CARD2.C0L.SINVEC) 

IF  ( M .LE.  0 ) GOTO  200 
GOTO  10 

38  IBLOCK(J)  = SETFLG 


SET00800 
SETOOblO 
5ET00820 
-SET00830 
SCT00840 
SETOOBSO 
SET00860 
SETOOdTO 
SET00880 
SET00690 
SET00900 
SET  00910 
SET00920 
5ET00930 
SET00940 
SET00950 
SET00960 
SET00970 
SET00980 
SET00990 
SETOIOOO 
SETOlOlO 
SET01020 
SET01030 
SET01040 
SET01050 
SET01060 
SET01070 
SET01080 
SET01090 
SETOllOO 
SETOlllO 
SET01120 
StT01130 
SET01140 
SET01150 
SLT01160 
SET01170 
SETOl 180 
SET01190 
SET01200 
SET01210 
SET01220 
SET01230 
SET01240 
SET01250 
SET01260 
SET01270 
SET01280 
SET01290 
SSLT01300 
SET01310 
SET01320 
SFT01330 
SEr01340 
SET01350 
SET01360 
SET01370 
SET01380 
SET01390 
SET01400 
SET01410 
SET01420 
SET01430 
St  T01440 
SLT01450 
SETOUbO 
SET01470 
SET01480 
5ET01490 
St  T01500 
St  TO) SI  0 
S£T01520 
SETO1530 
SET01S*0 
SFT01550 
StT01S60 
SETOISTO 
SET015H0 


on on  noon  noon  non on 


FILE:  SETUPl 


600 


610 

6U 


612 


613 

614 


{BLOCK  (J«U  > SETFL6 
IF  ( H .LE*  0 > 60T0  200 
GOTO  10 

CHANNELS 


J > NXTCHR(CAR02*C0U 

IF  ( J .EQ.  BLANK  I GOTO  200 

COL  ■ COL-1 

NOFEAT  s NUMBER (CAR02»C0LtFETVFC*N0FEAT) 

eliminate  out-of-range  reouestfo  features. if  any. 

ORDER  THE  RESULTING  FEATURE  VECTOR 


« NOFEAT  - 1 


NMl 
IF( 

00 
IPl 
IF( 

00 
IF( 

CONT.  ^ 

CONTINUE 
II  = 0 
DO  612  iBl.NOFEAT.l 
CHK  s FETVECdl 
IF(  CHK  .LE.  0 .OR.  CHK 


NMl 

2*1 

IPl 

^^TVEC(l) 
:iNUE 


1 


LE.  0)  NMl 
1»1.NM1.1 

!gI.  NOFEAT)  60 
J»IP1. NOFEAT, 1 

.EO.  FETVEC(J)) 


TO  611 

FETVEC(J) 


1*MAXFET*J 


II  = II  ♦ I 
FETVEC(II)  = 


.GT.  MaXFET)  go  to  612 


_ _ FETVEC(l) 

CONTINUE 
NOFEAT  = II 

IF(  NOFEAT  .EO.  0)  GO  TO  1303 
= NOFEAT  - 1 
NMl  .LE.  0)  NMl  > 1 
614  ^Isl.NMl.l 

IPl  !gt.  NOFEAT)  GO  TO  6U 
JslPl. NOFEAT, 1 


NMl 

IF( 

DO 

IPl 

IF( 

DO 

IF( 


613  _ , 

FETVEC(i)  .LT.  FETVECU))  60  TO  613 


TEMP  = FETVECm 
FETVECU)  » FETVECU) 
FETVECU)  = TEMP 
CONTINUE 
CONTINUE 
60  TO  200 

HISTOGRAM  CARO 


700  J = NXTCHR(CAR02,C0L) 

IF  ( J .EU.  BLANK  ) GOTO  200 
COL  = COL-1 

NOHIST  = NUMBER (CARD2,C0L,HISVFC,N0HIST) 

eliminate  out  of  range  requested  subclasses, if  any,  AND 

ORDER  the  resulting  SUBCLASS  VECTqR 


710 

711 


712 


NMl 

IF( 

DO 

IPl 

IF< 

00 

IF( 


= NOHIST  - 1 


NMl 
711 
= I 
IPl 
71Q 


1 


TO  711 

hISVECU)  = 


,LE.  0)  NMl  = 

1=1, NMl, 1 

IgK  NOHIST)  GO 
J=1P1. NOHIST, 1 
HlSVEC(I)  .EQ.  HISVECU)) 
CONTINUE 
CONTINUE 
II  = 0 

00  712  I = l , NOHIST., 1 

CHK  = HISVECU) 

IF(  CHK  .LE.  0 .OR.  CHK  .GT.  SyMMAX) 
II  = II  ♦ 1 

HISVECUI)  = HISVECU) 

CONTINUE 
NOHIST  » II 

IF(  NOHIST  .EQ.  0)  60  TO  1303 

NMl  = NOHIST  - 1 

IF(  NMl  .LE.  0)  NMl  = 1 


I*SYMMAX»J 


GO  TO  712 


SCT01590 

imm 

ro  620 

0 630 

ro  640 

imtn 

SET 01670 
SET01660 
SETO  690 
sETo  r* 
SETO 
SETOl  _ 
SET01730 
SET01740 
SET01750 
SET01760 
SET01770 
SET01780 
SET01790 
SETOiaOO 
SET01810 
SET01B20 
SET01B30 
5ET01840 
SETOlbSO 
SET01H60 
SET01870 
SETOlBflO 
SET01890 
SET01900 
SET01910 
StT0l920 
5ET01930 
SET01940 
SET019S0 
SET01960 
SET01970 
SET01980 
S£T0i990 
SET02000 
SET02010 
SET02020 
SET02030 
SET02040 
SET02OS0 
SET02060 
SET02070 
SET02080 
SET  02090 
5ET02100 
SET02110 
SET02120 
SET02130 
SET02140 
SET 02 150 
SET02160 
SET02170 
SF.T02180 
SET02190 
SET02200 
SLT02210 
SET02220 
SET02230 
SET02240 
SET  02250 
SET02260 
SET02270 
SET02280 
SET022V0 
SET02300 
SET02310 
SET02320 
SET02330 
SET02340 
SET02350 
SET  02? SO 
SET02370 


oono  on  o on  on  noon  oooo 


FILE 


SETUP 1 


713 

7U 


CONTINUE 


CONTINUE 
GO  TO  200 


l>l»NHltl 

• f. 

P 
) 

SVEC(I) 

H|svec.J. 


NOHIST) 

>ltN0HlS 

.LT. 


_ . 60  TO  7U 

HlSTtl 

HISVEC(J) ) 


60  TO  713 


SPEC  CAPO 


600  J s NXTCHR(CAM02*C0U 

IF  ( J .FQ.  BLANK  ) 60TO  200 

COL  = COL-l 

NOSPEC  s NOSPEC  ♦ 1 

IF(  NOSPEC  .GT.  20)  60  TO  200 

J > NUHBEH(CAP02*COL«NUMVEC*0) 

IF  ( J .GT.  A ) J s 4 

DO  610  laltJ 

IF  (NUMVEC(I)  .LE.  0 > GOTO  SlS 
810  SPCVEC(I»NOSPEC)  a NUMVEC ( I ) 

I = J»1 

815  SPCVEC <5. NOSPEC)  » I-l 
GOTO  200 

IBLOCK  CAPO 


1100  J = NXTCMP(CA«02,C0L) 

IF  ( J .£0.  BLANK  ) GOTO  200 
COL  = COL-1 

NflLOCK  = NUMBEW(CAR02.COL.NUMVfC»NBLOCK) 
DO  1110  I=1.NBL0CK,1 
IF  (NUMVEC(I)  .to.  1)  IBLOCKd)  a 1 
1110  CONTINUE 
60  TO  200 

SIZE  CAPO 


97  COL=COL-l 

1200  J = NXTCHR(CAHD2»C0L) 

IF(  J .KU.  BLANK  » GOTO  200 
IF  ( J .EO.  XUCO)  GO  TO  1220 

IF  ( J .EO.  SHCO)  GO  TO  1230 

IF  « J .EU.  YbCO)  GO  TO  1240 

GO  TO  1000 

1220  J = NXTChH(CAP02»C0L) 

M = FIN0l2(CAH02.C0LtSlNVEC) 

IF(  SINVEC(M)  .NE.  equal  ) GO  TO  1000 
M = NUMBER(CAW02.COL*NUMVFC.?9) 

IF(  J .to.  LMCO)  XLOW  = NUMVECOO) 
IF(  J ,EO.  HBCO)  XHGH  = NUMVECOO) 

IF ( J.NE.SBCD)  60  TO  97 
XSIZ  = NUMVECOO) 

GO  TO  97 

1230  M = FIN012(CAWD2.COL.S1NVEC) 

IF(  SINVEC(rl)  .Nt.  EQUAL  ) 60  TO  1000 
M s NUMBEH(  CAH02.C0L*N0MVEC»29) 
SPCBAS  = NU''^VtC(30) 

GO  TO  97 

1240  M = FIN012(CARD2*C0L»SINVEC) 

IF(  SINVEC(M)  .Nt.  EQUAL  ) GO  TO  1000 
M = NUMHEH(CAW02.C0L»NUMVEC.29) 

Y5IZ  = NUMVEcnO) 

GO  TO  97 

DATE  CARD 


1400  M = tMXTCHH(CARD2,C0L) 

1F<  M .EQ.  HLANK  ) GO  TO  200 


;T02380 
‘T02390 
d02400 
‘T02410 
!T02420 
StT02430 
SET02440 
SET024S0 
SET02460 
SET02470 
StT02480 
:T02490 
•T02500 

Mm 

>ET02S30 
SET02540 
SET02550 
SET02S60 
StT02S70 
SET025A0 
SET02590 
StT02600 
sIT02610 
5ET02620 
StT02630 
SET02G40 
SET02650 
SET 02660 
SET0?670 
SET02680 
SET02690 
SET0270O 
SET02710 
SET02720 
SET02730 
SLT02740 
SET02750 
SET02760 
SET02770 
SET02780 
SET02790 
SET02800 
SET02810 
SET02620 
Str02830 
StT02640 
SET02850 
SET02860 
SET02670 
StT02b80 
SET02890 
SET02900 
SET029i0 
5ET02920 
SET02930 
SET02940 
SET02950 
SET02960 
SET02970 
SbT0?980 
SETO2990 
5ETO3000 
SET03010 
Sf T03020 
Str03030 
be  T03040 
SET  03050 
SET03060 
SET03070 
SLT03080 
StT03090 
5ET03100 
StT03110 
SLT03120 
SET03130 
StT03l40 
SET03150 
StT03160 


FILE!  SETUP I 


RE«0  (30f999)  DATE 
999  FORMAT  (10X»ISAA) 


COMMENT  CANO 


ISOO 


REWIND  30 

GO  TO  200 

HEOl  CANO 


COMENT 


1600  READ  (30*999) 
rewYno  30 
GO  TO  200 


HE02  CARO 


HEOl 


1700  READ  (30*999)  HE02 
REWIND  30 
GOTO  200 


DATA  file  CARO 


1710 


1713 

753 


S 

c 


M s NXTCMH(CAN02*C0L) 

[F  (M  .ED.  HLANK)  GO  TO  200 
F (M  .EU,  UHCD)  GO  TO  1715 
IF  (H  .EO.  FbCO)  60  TO  1717 
WRITE(6*753) 

format (*  ERROR  ON  DATA  FILE  CaR0») 
fiO  TO  200 

1715  J = FIN0l2(CARO2*COL*EaUVEC) 

IF  ( J .to.  -1)  60  TO  1713 

M s NUHbER(CAH02.COL*0ATAPE*ZER0) 
COL  = COL  - 1 
GO  TO  1710 

1717  J = F1N012(CAH02.C0L.EQUVEC) 
IFU.fO.-l)  GO  ro  1713 
M s NUM8ER(CAH02.C0L*0ATFIL*ZEr0) 
DATFIL  = OATFIL  - 1 
IF  (DATFIL  .LT.  0)  OATFIL  » 0 
COL  a COL  - 1 
GO  TO  1710 

STAT  FILE  CANO 

1720  M » NXTCHR(CAR02tC0L) 

IF  (M  .to.  HLANK)  GO  TO  200 

IF  (M  .EQ.  UHCO)  GO  TO  1725 

IF  (M  .EO.  FhCO)  go  TO  1727 

WRITE(6*755) 

format <•  ERROR  ON  STAT  FILE  CaRD*) 
GO  TO  200 

J = FINOl2(CARn2*COL*EQUVEC) 

I'  ( J .tw.  -1)  GO  TO  1723 
M = NUMBEH(CAN02.C0L*SAVTaP*ZEp0) 
COL  = COL  - 1 
GO  TO  1720 

1727  J a FIND12  CAROZ.COL.EQUVeC) 

IF  (J  .to.  -II  GO  TO  1723 
M a NUMBtR(CAR02.C0L*St/ “ 

STAFIL  a STAFIL  - 1 
IF  (STAFIL  .LT.  01 
COL  a COL  - 1 
60  TO  1720 


1723 

755 

1725 


rAFIL*ZERO) 


I)  STAFIL  a 0 


CALCULATE  BASES  OF  TH£  ARRAYS 


900 


CONTINUE 

IF(  N05REC  .GT.  20)  NOSPEC  « 20 
IF(  NOSREC  .NE.  0)  GO  TO  950 
NOSPEC  a (MAXCLS*3)/4 
SPCVECd*!)  a 0 


SET.03170 
SET031M0 
|ET03190 
SET03200 
SET 032 10 
SET03220 
SET03230 
SETO32A0 
SfcT03250 
S|T03260 
SET03270 
SET03280 
SET03290 
SET03300 
SET03310 
SET03320 
SET03330 
SET033A0 
SETO33S0 
SET03360 
5ET03370 
SET033ftO 
SET03390 
SET03A00 
SET03A10 
SET03A20 
SETU3A30 
SET03AA0 
SET03A50 
SET03A60 
Ser03A70 
SET03Ae0 
SET03A90 
SET03500 
SET03510 
SET03520 
StT03530 
SET035A0 
St  TO 3550 
SET035b0 
SET03570 

setojsno 

SK  IO35N0 
SET03600 
St  TO  36 10 
SET03620 
StTO36J0 
SET036A0 
SET03650 
SET 03660 
SET03670 
St  TO 3680 
SET03690 
SET03700 
SET03710 
SET03720 
StT03730 
StT03740 
StTO3750 
SET03760 
SET03770 
SET03780 
St  T03790 
StT03fc00 
SET03H10 
SET03H20 
SET03M30 
SET03NAO 
StT03GS0 
StT03H60 
StT03a70 
StI03HH0 
-StT03O‘i0 
StTO.lYOO 
St,  TO  39 10 
St  TO 3920 
SET03930 
SET03V40 

strojvso 


^ V 


oon 


FILE*  SETUPl 


950  VARSI2  » NOFEAT* »NOFEAT*n/e 

8l 

l?Eci«<b*N0s?|crn/2*2 


iF(XSl2.LE.O)  XSI 
IfIXSIZ.OTjIOI) 


, XMQH-XLOW*! 
XSIZ«101 


COVARl«(VAHSI2*n/2*2 
AVAHla (N0FEAT*MAXSUB*1»/2*2 
CLSI01«<HAaSUB*T)/2*2 
SUBSV I « ( S*rtAXSUB* 1 » /2*2 
FLK£n1*N0KEAT*2 
FLVA»1«VARSI?*| 

SUBHN1»N0FEAT*2 

SUBVH1sVAHS12*2 

SUBSDla (NOFf AT*MAXSUB* 1 » /2*2 

SUeCL I « (MAXSUB* 1 ) /2«2 

MFTALla(XS|Z*NOHlST*n/2*2*MFOKEY 

MSTALla (XSI?*N0MIST*1)/2*2*HSBkEY 

SI7E=SFECI*C0VAhI*AVAR1*CLSI01*SU8SV1*FLMEN1*FLVAR1* 
• SUBMN 1 .SUHVH i *SUBSD 1 *SU8CL 1 *HFT AL 1 *HST AL 1 
MAxFU)=(TuH-s1zE-32)/32 
IF(MaxFLU.LE.O)  go  to  1300 
SPFC1=1 

COVAMl=SPtCl*  <S*N0SPEC*1)/2 
AVARlsCOVARl*  (VAHSU»1  )/2 
CLSIOl=AVARl* (N0FEAT*MAXSU8*1  )/2 
SUBSVlsCLblOl* (MAXSU8*1)/2 
FLMtNlsSUMSVl* (5«MAXSUH*1 ) /2 
FLVARlrFLPtNl *NOFtAT 
5UHMU1=FLVA»1 *VAWbI7 
SUBVR I =SUMMN  J ♦NOKE AT 
SUMSiJl=SUhVRl  ♦VAWSIZ 
SUPCL  1 =SUiiS01  ♦ (NOFKAT*MAXSU8*  1 ) /2 
►^FTALlsbURCLl  * (MAXSUB*  I ) /? 

HSTAL  1=MF TALI  ♦ (XSIZ*NOH  1ST*  U/?*HF0KEY 
FLOSV 1 =HST  AL 1 ♦ ( XS 1 /“NOHIST ♦ 1 ) /?*HSBKEY 
SAVFHl =FluSV1 ♦ ( 1 0»MAXFLD) /2 
TIPTORrSAVLtU  ♦<2;'*'MAXFL0)/2 
8AncuR=  rOP-?*TIPTuP 
IF (haOCUM.LT.O)  GO  TO  1300 
PRINT  OUT  OPTIONS 

WRI  TF  AO) 

IF (PCMKF Y*SSFKFY*rFnKfcY*HSHKFY«HFOKEY*SSLKFY 
1 ♦SFl)KEY*CALKtY  .Lt.  0 ) GOTO  960 
WRITF(6tV001) 

IF(CFUKtY  .FQ.  I)  WRITE (6, 9002) 

IFIbFOKFY  .EO.  1)  WRITE(6.900A) 

IF (SSLKFY.EO,  1)  W«1 Tt (6t9006) 

IF(PCHn(,Y  .EO.  1)  WRITE  (6»9008) 

IF(  HFOKET  .EO.  1)  WRI TE (6.9012) 

IFlHSHKtY.EQ. 1)  WRITE(6.90IA) 

IF  ( CALKtY  .FQ.  I ) WHITE (6.9016) 

IF (SSFKEY.tO. 1)  wHlTE(6.9016) 


9001 

9002 
900A 
9006 
9()0ri 
9012 
9014 
90)6 
901  H 

960 

9502 


FORMAT (IX. *YOU 

ins:  •//) 

FORMAT ( T5. • 
forma  r ( T5. • 
format (T5. • 
FORMAT ( T5. • 

F OBMAl  ( T5 . • 
forma  r { T5. • 
format ( TS. • 

F ORMA  r ns . • 


HAVE  SELECTED  ThE  FOLLOWING  SSTAT  PROCESSOR  UPTI 


PRINT  MEAN  AND  COVARIANCE  FOR  EACH  FIELD') 

PHInI  SPFCTRAL  plot  for  EACH  FIELD') 

PRINT  SPFCTRAL  plot  for  FaCH  SUMCLASS') 

PUNCH  MFAN  AND  COVaRIaNCE  MATRIX  FOR  EACH  SUBCLASS') 
PRINT  A HISTOGRAM  fOR  LACM  FIHO') 

RRINT  A HlsrOGRAM  FOR  EACH  SUBCLASS') 

*•*  USE  CALIHhAIFU  data  ••*•) 

PRIN)  MEAN  AfJO  covariance  FOii  FACH  SUBCLASS') 

WRI  (f  (6.9S0P)  HAOCOH.MAXFLn.RA.SUH.  ( FF T VF C ( I ) . I = 1 .NOFEaT) 
forma  f (•  I)  •//•  OSUPF  WV  ISOR  1 NF  <)Hv,  A r 1 ON  : • // Ts  • • UNuSF  D C0RF'.I6.'  IOC 
•nONS'/ IS.  'MAXIMUM  NO.  OF  F I F I nS  . . • . I T/ T H , ' M A X 1 MUM_  NO  . OF  SURCi.AS 


2ES.  . . • . 1 3/ rs. • CHANnFLS 
IF(  HF  t'Kh  Y*MCLKEY  .nf; 


SELFCTF.O  are  • 
0)  wwl Tf (6.9504) 


CHANNFLS  AWE 
n ) GOTO  9/1 


9504  format ( IS. 'HISTOGRAM 
1F(  bPCVECd.ll  .EO. 

WRITE (6.9S0S) 

9505  format (IS. 'MULTISPFtTHAL  PLOTS  ARE 
DO  9/0  J -l.NOSPEC 

K = SPrvKC(5.J) 

WRITF  (6.9S06)  (SPCVEC ( I . J)  . 1 = ) .K) 

9506  format ( Ta4, t ) • .T  31 . ' ( • .4 ( I 2. • , I ) ) 
970  CONflNUt 

9/1  CONTiNUt 


1 5 ( n . • . • ) / 1 2 / . 1 5 ( I 3 . • . • ) 
(HISVFC ( 1 ) . 1=1 .NOHIST ) 
'.15(13. '.*)/T2h. 15(13.'.')  ) 


' ) 


SET03V60 
SET039T0 
SET039B0 
SET03990 
SET04000 
5ET04010 
SET04020 
SET04030 
SET04040 
SET04050 
SET04060 
5ET04070 
SKT04O80 
S£T04090 
SET04100 
SET04110 
SET04120 
SET04130 
SET04140 
SET04150 
SET04160 
SET04170 
SET041A0 
SET04190 
SET04200 
Sf T04210 
SET04220 
SET042J0 
St  T04240 
SET04250 
SET04260 
SET04270 
SET04280 
SET04290 
SET04300 
SET04310 
SET04320 
SLTO4330 
SET  (14340 
-SET04350 
SET04360 
SET04370 
SET043H0 
SET04390 
SLT04400 
SLT04410 
SET04420 
SET04430 
SE  T 04440 
SET04450 
SET04460 
SET04470 
SET04480 
SET04490 
05ET04500 
SET04510 
SET04520 
SET04530 
SF:T04540 
SET  (IaSSu 
SET04560 
SET045/0 
SET  045H0 
SE  T 04590 
SET  04600 
ASt  T Owb 1 0 
SSF  t OAbPO 
)StT04630 
SF.  T 0<*640 
SF  T O46S0 
SF  r 04660 
SF  I 046/0 
SF-T046MO 
SF  T04690 
SET04700 
SF  Tu<,  /10 
S F T 0 •«  / ? 0 
SF  T04  /30 
SET04740 


rx-ino 


FILCi  SETUHl 


980  RETURN 
ERROR 


ROUTINES 


1000  WRITE 


JTE  100021  CODE*  CRRD2 

10002  format «///SX» */////  FROM  fUBH,  S 
ilTEKEO  — INPUT  CARO  IS  ...» 


SETUPl  BAD  ^ _ 

V/BX,2H*'*AA*6»f62Al«2H*« 


//I 


lOUNTEKCO 
GO  TO  200 

1300  WRITE  (6»1302) 

1302  FORMAT!////  SXj  •/////  FROM  SuBR*  SETUPl  utv."c«ac_wr  i ly 

...  terminating  program  execution  from  SUHR.  SETUPl 


//  5A. *•*••• 


go  TO 

1303 

13031  format U/bX**CHECA  CHANNELS  OH  SUBCLASS  NO.S  REOUESTEO-CANNOT  BE 


CAR02 


terminating  PROGRAM  FXECUTION  FROM  SUriH.  SETUPl 


1 LESS  Than  oh  EOUAL  zero*  OR  GREATER  THAN* * 15///SX* 
g • •••••  TERHII 

3 /IHI) 

1.305  CALL  EXIT 
END 


SET0A750 
StTOATGO 
SIT0A770 
>«SflOA7eO 
S|T0a790 
SETOaBOO 
CONTROL  CARO  ENCStTOAOlO 
SET0Ae20 
SET0A830 

sltoabao 

SEIUA650 

— DECREASE  OPTIONS*  SttOABGO 

* ••StTOAbTO 

SETOaBAO 
SLT0AB90 
SETOavOO 
SETOARIO 
SET0AV20 
5ET0A930 
SET0A9A0 
5ET0A950 
SE'^OA960 
St  I OA970 


^^0 


9.  ISOCLS  PROCESSOR 


Sae  listings  for  the  TESTS?  processor  (section  23)  for  an 
iterative  self-organizing  clustering  procedure  using  sample  values 
of  pixels  clustered  in  packed  form  on  disk  storage. 


FILE  IS0CL5 


C* 

C** 


SUBROUTINE  ISOCLS(ARRAYtTOP) 


C* 

8: 

c* 

s: 

c» 

c* 


c 

i 

c 


THIS  PROGRAM  PFRFORMS  A MOOIFIEO  VERSION  OF  THE  CLUSTERING 
ALGORITH  (ISODATA)  ORIGINALLY  DEVELOPED  BY  BALL  AND  HALL  OF 
STANFORD  RESEARCH  INSTITUTE.  THE  ALGORITHM  HAS  BEEN  MODIFIED 
ON  THE  recommendations  OF  ED  KAN  (LEC» . 

THE  PROGRAM  EXPECTS  MULT  I SPECTRAL  SCANNER  DATA 
IN  either  THE  LARSYS  22  OR  THE  UNIVERSAL 

format.  THE  DATA  TAPE  SHOULD  BE  ASSIGNED  TO  FORTRAN  UNIT  3. 


IMPLICIT  INTEGER  (A-X) 
INCLUDE  C0M8K5.LIST 
INCLUDE  C0MNT5.LIST 
INCLUDE  C0MBK6.L1ST 


INCLUDE  CMbKIG.LIST 

COMMON/PASS/STOP. LNCAT.NMIN.KRN.STOMAX.OLMIN.se 

MAR.SPTRIG.  IRD.  KPT! 


« NOPTS.  PUNCH, 


ICHN,CHNTHS.ICHAIN(62) .NrDS. IHEGIN.PEGINl , 

BFGIN2.PEGIN3.CLSNAM.N0FLD.iPi .Tuiwko, iuiki: 
NCLASS.NOCLS.TOTSUB.TOTFLO.TOTVRT.NOCL.NVRT 


* 

* 

• .NXTCLS.NOFFAT.MAXCLSiFETVECOO)  .SYMMTX(62)  _ 

♦.VARSIZ.STATKY. I SOKE Y.MAPFMT.MAPKEY. SEQUENT  20) .PERCEN.SIMERP 
•.IOROER.INIINIT.  INFILE.  INI TM.PMIN.SUBVEC  (62)  .NOSU02.CHNVCOO) 

* .NOCHAN.ERCOMP.NOSEO.MFANOO.MEANOU. 

SYMOO.SYMOU. ITRIGO. ITPIGU.OOFLAG. 


DUFLaG.DOOU.STOOTS(60)  .NSDOTS.SUNCOROO)  .llncat. 
DVERT(250.2) .ORECTt60.2) .OVPNT ( 1 I .2) . IDCNT (2) .N00U(2) 

.mxfeti.maxpop 

REAL  SUNCOR 

COMMON  BLOCK  'PASS*  IS  USED  ONLY  BY  THE  ISOCLS  PROCESSOR. 


c« 

c 

COMMON  BLOCK 

8: 

ISOCLS  USES 

c« 

SEE  OEFINITI 

c» 

c* 

DEFINITIONS 

s: 

ISTOP 

£: 

LNCAT 

c» 

NMIN 

c* 

e* 

KRN 

c» 

c* 

stomax 

c* 

c* 

OLMIN 

c* 

SEP 

c« 

8: 

MAP 

c« 

SPTRIG 

* 

c* 

IRO 

• 

8: 

NOPTS 

c* 

CONTINUE 

KPTS 

m 

c* 

PUNCH 

c* 

c* 

ICHN 

c* 

CHNTHS 

* 

c» 

ICHAIN 

• 

c* 

c* 

nwds 

c* 

c* 

IBEGIN 

c* 

c* 

BEGINS 

c* 

c* 

BEGINl 

• 

MAX.  NO.  OF  ITERATIONS  FOR  THE  CLUSTERING  PROCEDURE 
SET  IN  SETUP?  ROUTINE.  (USER  INPUT)  . ^ 

CURRENT  NO.  OF  CLUSTERS.  SET  INITIALLY  IN  ROFILE  OR  IS 
ISOCLS.  then  only  in  ISODAT. 

MIN.  NO.  OF  POINTS  TO  ALLOW  PER  CLUSTER 
SFT  IN  SETUP?  ROUTINE.  (USER  INPUT) 

PRINT  CLUSTER  SUMMARY  EVERY  »KRN*  ITERATION(S) 

SET  IN  SETUP?  ROUTINE.  (USER  INPUT) 

STANDARD  DEVIATION  FOR  SPLITTING  CLUSTERS 
SET  IN  SETUP?  ROUTINE.  (USER  INPUT) 

MIN.  DISTANCE  BETWEEN  CLUSTERS  FOR^COMBINING. 
distance  TO  SEPARATE  CLUSTERS.  SET  EIGHER  IN  SETUP?. 
HY  USER  INPUT,  OR  IN  ID 

BY  USER  INPUT,  OR  IN  ISOOAT,  ^ , 

PRINT  A CLUSTER  MAP  EVERY  ‘MAP*  ITERATION (S) - SETUP? 
TRIGGER  TELLING  WHETHER  OR  NOT  »SEP*  WAS  INPUT.  -SETUP 
NO.  OF  RECORDS  TO  READ  FROM  DATA  FILE.  COMPUTED  IN 
ISOCLS 

NO.  OF  POINTS  IN  EACH  RECORD.  COMPUTER  IN  ISOCLS 

NO.  OF  POINTS  IN  LAST  RECORD.  COMPUTER  IN  ISOCLS 
TRIGGER  TELLING  WHETHER  OR  NOT  TO  PUNCH  THE  MODULE 
STAT  deck.  - SETUP? 

trigger  telling  whether  or  not  chaining  is  to  re  DONE 
MIN.  distance  between  clusters  for  chaining  - SETUP? 
ARRAY  containing  CHAINED  CLUSTER  NUMBERS.  SET  IN 
•CHAIN!  ROUTINE. 

TOTAL  NO.  OF  WORDS  AVAILABLE  FOR  DRUM  STORAGE  OF 
IMAGE  DATA  TO  BE  CLU5TERF0  - SET  IN  ISOCLS 
beginning  drum  FILE  ADDRESS  FOR  INPUT  INITIAL  CLUSTER 
CENTERS  - SFT  IN  ISOCLS 

beginning  drum  FILF  address  for  TEMPORARY  STORAGE  OF 
CLASS  STATISTICS  - SET  IN  ISOCL'’  ROUTINE 

beginning  drum  file  address  for  image  data 


ISOOOOlO 

ISOOOQZO 

S000030 

SOOOOAO 

sooooso 

S000060 

S000070 

S000080 

S000090 

SOOOlOO 

.SOOOllO 

15000120 

soooiSo 

SOOOIAO 

SO00I50 

S000160 

S000170 

.SOOOIBO 

IS000190 

S000200 

soooaio 

S000220 
S000230 
S000240 
S000250 
S000260 
.5000270 
IS0002SO 
S00029* 
S00030 
.S00031, 
IS000320 
S000330 
S000340 
SO003S0 
S000360 
SOOQ370 

SOOOAOO 

S000410 

S000420 

S000430 

SO00A40 

SO004SO 

S000460 

S000470 

S000480 

.S000490 

ISOOOSOO 

SOOOSIO 


SOOOS20 

000530 

O00S40 


S00055 
S00056 
S00057. 
.S000580 
IS000590 
S000600 
.S000610 
IS000620 
IS000630 
IS000640 
IS000650 
1S0006KO 
IS000670 
IS000680 
IS000690 
1S000700 
IS0007IO 
IS000720 
IS000730 
IS000740 
ISOOC750 
IS000760 


FILE  ISOCLS 


i 


_• 

C* 

II 

c* 

c* 

c* 

• 

• 

c» 

c* 

c* 


BE6IN2  - beginning  DRUM  FILE  ADDRESS  FOR  *IPLACE» 
WHICH  CORRESPONDING  POINT  BELONGS.) 


.ICLUSTER  TO 


CLSNAM 

NOFLD 

IPT 

TOTWRD 

TOTPTS 

NCLASS 


NAME  OF  CLASS  CURRENTLY  BEING  PROCESSED.  - RDDATA 
NO.  OF  FIELDS  INPUT  FDR  THIS  CLASS  - RDDATA 
NO,  OF  WORDS  OF  STORAGE  < GEO  IN  » ARRAY*  FOR  FIELD  AND 
CLASS  INFORMATION  FOR  THIS  CLASS.  - RDDATA 
TOTOL  WORDS  WRITTEN  ON  DRUM  FILE  BEGINNING  AT  ADDRESS 
BEGINI  - RDDATA 


IS000770 

ISO007B0 

IS000790 

ISOOOBOO 

isoooBio 

|SO00B2O 

ISO00B30 

IS000640 


- TOTOL  POINTS  TO  BE  CLUSTERED  FOR  CURRENT  CLASS  - RDOATISOOOBSO 


8 


NO.  OF  CLASSES  TO  BE  CLUSTERED  FOR  CURRENT  CALL  TO 
ISOCLS.  USER  INPUT  - SETUP7. 

NOCLS  - CURRF.NT  CLASS  NO.  - ISOCLS 
T0TSU8  - TOTAL  CLUSTERS  FOR  THIS  CALL  TO  ISOCLS 
TOTFLD  - TOTAL  FIELDS  FOR  ALL  CLASSES  - ISOCLS 
TOTVRT  - TOTAL  VERTICES  FOR  ALL  FIELDS  - ISOCLS 
NOCL  NO.  OF  CLASSES  SINCE  LAST  CALL  TO  SETUP  - RDDATA 
IEY033I  COMMENTS  DFLETFO  ••*•*************•**♦**•••#•*••*•*••**•••« 


CSEND 


C* 

C* 

C* 

C* 

C» 

C* 


C* 

C 

C* 


210 


common/global/he  AD (63) , MART AP, OAT APE »SAVTAP.HMFILE*BMKEY, 

* HISFIL.HISKEY.TRF0RM»ER1PTP,ERPKEY»MAPUNT»N0FILE, 

* 0PUMAD.DRMWI)S,PAGSIZ.DATFIL»STAFIL»ASAV»ASAVFL 

* .NHSTUN.NHSTFI .sctrun.mapfil 

* .DOTUNT.DOTFIL.NCHPAS.TRNSFLtBMTRFLtHISTFLtPCHUNT* 

* CROUNT.PRTUNT.HANOIO 

C0MM0N/IS0LNK/SUNANG(8) * ISUNT»ISUNC*SMSTR,SMSTP,SMINC.L1NSKP 

dimension  KVAR(llSOO) 

KVARDM  = 11500 
DIMENSION  ARRAYd) 

DIMENSION  COVAR(465) 

DIMENSION  NN(60) 

DATA  SYKDA  /•*  */»SYMD8  /•#  •/ 

MAXP0P=62 

MXEET1=30 

IBEGINsORUMAD 

RESERVE  ENOUGH  DRUM  STORAGE  FOR  MAXIMUM  INITIAL  MEANS 

BE6IN3=IBE6IN  ♦ MAXPOP*MXFET 1 ♦ MXEETl  ♦ 2 

CALL  SETUP  TO  READ  CARD  INPUT  AND  INITIALIZE  DEFAULT  VALUES 

ITIMEsI 
NOCLS  = 0 
TOTFLD  = 0 
TOTVRT  a 0 
TOTSUB  a 0 
CORBASal 
ITRIGU  a 0 
ITPIGOaO 
SYMOO  a SYMDA 
SYMDU  a SYM08 
MEANDO  a 0 
MEANDU  a 255 

CALL  SETUP7< ARRAY (CORBAS) .TOP.ITIME) 

IDUM  a MAXCLS 

IE  { ITIME.GT. 1 )GO  TO  2 

VAPSIZ=NOFEAl*(NOFEAT»l)/2 

BEGINI  a BEGIN3  ♦ NCLASS*MAXPOP* (VARSIZ  ♦ NOFEAT  ♦ 1) 
NWnSaORMWOS-IBEGINl-ORUMAO) 

ITIME=ITIME*1 

NOCLaO 

CALL  RDDATA  TO  COORDINATE  READING  OF  DATA 

MAXOTM  = T0P-C0R8AS 
FOlaCORBAS 

CALL  ROD AT  A ( ARRAY (FOl ) , MAXD I M , KV AR * K V AROM , LAST ) 

MAXCLS  a IDUM  ♦ OOOU 
WRITF(6.?10)  Nnoun  ) .NDOIH?) 

F0PMAT(1X.//»  00/nU  cluster  pop  for  this  CLASS  **217) 

REGINZrriEGINl  ♦ TOTWRD 

N1  = FOl  ♦ IPT 

MFANSl=Nl  ♦ MAXCLS 

STDEV1=MF ANSI  ♦ MAXCLS*NOFEAT 

TTOP  = STDEVl  ♦ MAXCLS»N0FEAT 

MAXDIM=TOP-TTOP 


IS000860 

ISO00B70 

ISOC08BO 

IS000890 

IS000900 

IS000910 

IS000920 

IS001200 

IS001210 

IS001220 

IS001230 

IS001240 

ISO0I250 

1S001260 

IS001270 

IS001280 

IS001290 

IS001300 

IS001330 

IS001340 

IS001350 

IS001360 

IS001370 

IS001380 

ISO01390 

IS001400 

IS001410 

IS001420 

IS001430 

IS001440 

IS001450 

IS001460 

ISO01470 

IS001480 

IS001490 

IS001500 

isooisio 

IS001520 

IS001530 

IS001540 

IS001550 

IS001560 

15001570 

IS001580 

1S001590 

IS001600 

IS001610 

IS001620 

IS001630 

ISO01640 

IS001650 

IS001660 

IS001670 

IS001680 

ISO01690 

IS001700 

1S001710 

1S001720 

IS001730 

IS001740 

ISO017S0 

1S001760 

ISO0177O 

ISO017B0 


j»y 


FILE  ISOCLS 


NOPTS  « MAXOIH/(NOFEAT*l> 
lOATl  « TTOP 

IF  (NSDOTS.EQ.Oi  60  TO  4 

?OTDMF  X nochan 
YPSWT  X 1 

, CALL  R000ts(ARPAY(MEANSl) •STDOTStNSOOTSt 
• TYPSWTfDOTOHF.nOTOHC*DOTOUM,COVAR» 

* NOCHANtCHNVC»OTDM,COVAR« 

* OOTOM«nOTOM«QOTOM,nOTOM«OOTOH«OOTOH«KVAR) 

LNCAT  X NSOOTS 
00  500-  I X 1. NSOOTS 
no  500  K X I.NOFEAT 

HI  X (I-1)«N0FEAT  ♦ K 
* III  ♦ mfanSi  - 1 
500  ARRAY<in  X KVAM(Ili) 

IF  (NOCMAN.EO.NOFEATl  60  TO  S 
WRITE(6*U0) 

no  FORHATdH  «*NO  CHANNELS  FOR  STARTING  NOT  EQUAL  THAT  FOR  CLUSTER*) 
60  TO  9 
4 CONTINUE 

IFUSOKEY.EO.nGO  TO  7 

C*  SUBVEC-SURCLASSFS  FROM  STATISTICS  FILE  FOR  INTIAL  MEANS. 

c»  nosub?-num8fr  of  initial  means. 

C*  CHNVFC-NUMBER  OF  CHANNELS  FROM  STATISTICS  FILE.  NOCHAN  MUST  EQUAL 

IFdNITM.EO.DGO  TO  6 
LNCATxl 

60  TO  e 

6 LNCATxNOSUB? 

CALL  GFTSTd NUN IT.1NFILE.ARHAY(ME ANS 1 ) t DUM « N0SUB2 ♦ SUB VEC ♦ NOCh AN 
• .CHNVC.ARRAY<TT0P) .COVAR.O) 

LNCAT  X N0SUB2 
GO  TO  8 

7 CONTINUE  

IF dSOKF Y.EO. 1 ) CALL  ROFILE (ARRAY (MEANSl ) .ARRAY (TTOP) ) 

8 CONTINUE 

IF(NOPTS.GT.O)GOTO  10 

RRITE(G.100)MAXOIM  ^ 

100  FORMAT (•  DIMENSION  LIMITS  EXCEEDED  IN  ISOCLS  BY*. 16. 

* • REDUCE  CHANNELS  OR  MAX. CLUSTERS* ) 

9 CALL  CMERR 
10  CONTINUE 

IRDxTOTPTS/NOPTS 

IF(MOD(TOTPTS. NOPTS) .EO. 0)60  TO  20 
KPTS=MOD(TOTPTS. NOPTS) 

IRDxIRO*! 

IFdRD.EO.DNOPTSxKPTS 
GO  TO  25 
20  KPTSxNOPTS 
25  CONTINUE 

CALL  ISODAT  TO  PERFORM  CLUSTERING 
Alxl 

A2=A1*  MAXCLSxnOFEaT 
CL01=A2  ♦ MAXCLS*N0FEAT 
KPLCF  X N0PTS*N0FEAT  ♦ lOATl 

CALL  ISOOAT(ARPAT(TOAT1) .ARRAY(KPLCE).ARRAY(MEANS1) .ARRAY(Nl) . 

• ARRAT(STOEVI) .KVAR  (CLOl ) .ARRAY (FDl ) .KVAR (A1 ) . 

* KVAW(A2)) 

CHAIN  CLUSTERS  WHOSE  DISTANCES  ARE  LESS  THAN  OLMIN 


C« 

C* 

C» 


e: 

c* 


g: 

c* 


c* 

c« 

c* 


c» 


LNCATxLNCAT*DOOU 

IFdCHN.GT.OCALL 


CHAIN(KVAR(CLD1) ) 


PRINT  final  results 

CALL  PRINT (-I.ARPAY(KPLCE) .ARRAY (MEANSl >. ARRAY (STDEVl ) . 

» KVAR  (CL01).ARRAY(FD1).ARRAY(N1)) 

CREATE  MAP  OUTPUT  TAPE  FOR  PMlS  DAS  IF  DESIRED 

IF(MAPFMT.GT.0)CALL  DSTAPE(ARRAY(KPLCE)  .KVARd)  .ARRAY(MEANSl)  . 
> ARRAY(FOD) 

LNCATxLNCAT-OODU 


S001790 
S001800 
5001810 
S0018?' 
500182^ 
S00184I 
SO018S(l 
SOO  860 
SOO  870 
SOO  880 
SOO  890 
SOO  900 
SOO  910 
SO01920 
SOO 1930 
SOO  .940 
SO01950 
S001960 
S001970 
S001980 
SOO  990 
S0(>2000 
IS002010 
IS002020 
1S002030 
IS002040 
IS002050 
15002060 
1S002070 
IS002080 

iS002090 
S002100 
S002110 
S002120 
15002130 
IS002140 

ilssilis 

15002170 

IS002180 

IS002190 

IS002200 

1SO02210 

IS002220 

IS002230 

15002240 

1S002250 

IS002260 

IS002270 

IS002280 

IS002290 

IS002300 

1S002310 

IS002320 

IS002330 

IS002340 

IS002350 

IS002360 

1S0023TO 

IS002380 

1S002390 

15002*00 

15002*10 

15002*20 

15002*30 

15002**0 

ISO02*50 

15002*60 

15002*70 

15002*80 

15002*90 

1S002500 

ISO02519 

1S002520 

IS00253U 

150025*0 


FILE  ISOCLS 


C« 

C» 


CALCULATE  covariance  MATRIX  FOR  EACH  CLUSTER 
IF(VARSIZ*LNCAT.6T.KVAR0M)60  TO  30 

CALL  COVARI (KVAH. ARRAY ( lOAT  U • ARRAY (KPLCE) t ARRAY (MEANSl ) t 
• ARRAY (Nl) tIBAO) 

CHECK  FOR  AT  LEAST  ONE  SUBCLASS  DELETED  FOR  SINGULAR  MATRIX 


C* 


IF  (IBAO.NE.O)< 
1F(IBA0.NE.0)G{ 


^To“i 


ARRAYtNl»II-l) 

LNCA' 

NOFLD 

NVRT 

FOl 


C* 

C» 

C« 

C* 


DO  26  II*1*LNCAT 
26  NN(T0T5UB^I1)  » 

TOTSUB  * T0TSU8  ♦ 

NOCLS  = NOCLS  ♦ 1 
TOTFLO  » TOTFLO  ♦ 

TOTVRT  = TOTVRT  ♦ 

ARPAY(FD1*1)=IPT 
ARPAY(F01*2)=LNCAT 
ARRAY tF01^3)=N0FLD 

J WRITE  STATS  FOR  THESE  CLUSTERS  ON  SCRATCH  FILE  18 

IF (NOCLS. EQ.l)  ADRES=BEGIN3 
IN=N0FFAT*LNCAT 

CALL  RWRITE (ADRES*ARRAY(MEANS1) f IN«JSTATI 

adpes=aores*in 

in=vapsi?*lncat 

CALL  RWPITE (AORES.KVAR.IN.LSTAT) 
aores=ao«fs*in 
WAIT  FOR  I/O  completion 
60  IF(LSTAT.EO.l)  60  TO  60 

60  READ  IN  ANOTHER  CLASS 


c* 

c* 


C0RBAS=C0R8AS*1PT 
IF(LAST.NE.1)G0  to  I 
1FCNOCLS.lt. NCLA5SH 


10  to  1 


NOW  read  scratch  file  and  store  on  savtap  file  and  punch  on 
CAROS  IF  requested. 


c 

c 

c 


c 

c 

c 


FLOl  = 1 
VEPTXl  = 
CLSNMl  = 
NOSURl  = 
SU8NM1  = 


FLOl  ♦ 
VERTXl 
CLSNMl 
N05UB1 


TOTFLO*A 

♦ T0TVRT*2 

♦ NOCLS 

♦ NOCLS 


RETRIEVE  INFORMATION  FROM  'ARRAY* 

call  6ETINF ( ARRAY( 1) .KVAR(FLOl) .KVAR (VERTXl ) »KVAR (CLSNMl ) * 

• KVAR(NOSUBl) .KVAR (SUBNMl ) .NOCLS*TOTSUB> 

SWTCH  a 1 
OUTPUT  STATS 

CALL  LAPMANCSAVTaP.STAF I L.NOCLS.TOTSUB.NOFEAT. TOTFLO. TOTVRT. 

* FETVEC. KVAR (FLOl) . KVAR ( VFRTX 1 ) .KVAR ( CLSNMl ) .KVAR (NOSUBl ) » 

♦ KVAR(SUBMM1 ) ,NN.BE6IN3.VAHSIZ. Punch. DUMMY, STATKY.SWTCH) 
RETURN 

30  KV=KVARDM 

WRITE  (»S.200)KV 
CALL  CMERP 

200  FORMATC  dimension  limit  0F*.I6,*  FOR  covariances  EXCEEDED*) 
RETURN 
END 


IS002S50 
IS002S60 
S002570 
S002S80 
S00259‘ 
SO0260 
[SO0261 
S00262 
S00263I 
S0026A . 
IS0026SO 
1S002660 
IS002670 
S002680 
IS002690 
1S002700 
S002710 
iS002720 
S002730 
IS0027AO 
15002750 
IS002760 
1S002770 
IS002780 
IS002790 
IS002800 
1S002810 
IS002820 
IS002830 
ISG028A0 
S002850 
S002860 
IS002870 
S002880 
IS002890 
IS002900 
15002910 
IS002920 
IS002930 
IS0029AO 
IS002950 
IS002960 
IS002970 

iSO02980 
S002990 
S003000 
1S003010 
1S003020 
1S003030 
IS0030AO 
ISO030S0 
IS003060 
15003070 
IS003080 
IS003090 
IS003100 
15003110 
IS003120 
IS003130 
IS003140 
1S003150 
IS003160 
IS003170 
IS003130 
15003190 
IS003200 
IS003210 


FILF 


COVAPl 


C« 


CSENO 


SURROUTINE  COVARl (COVAR.C* IPLACE *MEANS»N. I8A0» 

IMPLICIT  INTEGEH  U-X» 

SURROUTINE  COVARR  CALCULATES  AND  PRINTS  THE  COVARIANCE  MATRIX  FOP  CO 
EACH  CLUSTER  CO 

INCLUDE  C0MRK5.L||T 

COMMON/PASS/StSp  »LNC  AT  ♦ NM  IN  . KRN  • STDMAX  ♦ OLM  IN  .SEP*  _ ___  _ 

• MAP.SPTRIG.  IRD.  KPTS*  NOPTS*  PUNCH* 

* ICHN,CHNTHS.ICHAIN(6?) .NV0S.IPEGIN.BE61N1, 

• begin?. BEGINS. CLSNAM.nOFLO.IPT.TOTVRO.TOTPTS* 

• NCLASS.NOCLS.TOTSUB.TOTFLO.TOTVRT.NOCL.NVRT 

* .NXTCLS.NOFEAT.MAKCLS.FETVECOO)  .SYMMTX<A2) 

•♦VsRSIZ.STaTkY. ISOKEY»MAPFMt.mapkey.5EQUEN<20) .PEPCEN.SIMERP 
•.lOROER.INUNlT.  infile.  INI  TM.PMIN.SUBVEC  (62)  .N0SUB2.CMNVC  (30) 

• .NOCMAN.ERCOMP.NOSEU.MEANOO.MEANOU. 

• SYM00.SYM0U.ITRI60. ITRI6U.D0FLA6. 

* OUFLAG»OOOtJ.STOOTS(60) .NSDOTS.SUNCOP (30) .LLNCAT. 

* OVERT  (250.2)  .DRtCT!60.2)  .OVPNT  (U*2)  * lOCNT  (2)  .N00U(2) 

• .MXFETI .MAXPOP 
REAL  SUNCOR 

C0MM0N/6L0BAL/HEa0(63)  .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY.^.  ^ 

• HISFIL.HISKEY.TRFORm.ERIPTP.ERPKEY.MAPUNT.NOFILE* 

* DRUMAO.ORMWOS.PAGSIZ.OATFIL.STAFIL.ASAV.ASAVFL 

♦ .NHSTUN.NHSTFI.SCTRUN.MAPFIL  

* .OOTUNT.OOTFIL.NCmPAS.TRNSFL.BHTRFL*HISTFL*PCHUNT, 

* chount.prtunt.manoio 

REAL  MEANS. COVAR.C.TOL.OUMM(60) .OFT 

DIMENSION  c (NOFEAT. NOPTS)  _ 

niMENSION  COVAR(VARSIZ.LNCAT) . IPL ACE (NOPTS) 

DIMENSION  means (NOFEAT. MAXCLS) .N(MAXCLS) 

DATA  CH/»CH(*/ 

TOL=. 000000001 
IRAD=0 

DO  10  Isl.LNCAT 
DO  10  Jsl.VARSlZ 
10  COVAR(J.I)bO.O 

A0PESl=aF.6INl 
A0»ES2=  BEGIN2 
ICCTsNOPTS 
1RC=IR0 

20  IF(IRC.LE.l) ICCTsKPTS 
IF  (IRD.EO.O)  GO  TO  30 
ivrds=icct*nofeat 

CALL  RREAO(AORFSI.C.IvROS.ISTAT) 

A0PES1=ADRES1*IwR0S 
22  IFdSTAT.En.DGO  TO  22 

CALL  RWEAO( AORES2.IPLACE.1CCT.ISTAT) 

ADRES?=ADRES2*1CCT 
25  IFdSTAT.EQ.DGO  TO  25 

SINCE  THE  COVARIANCE  MATRIX  IS  SYMMETRICAL  ONLY  THE  LOWER 
triangular  PORTION  OF  THE  MATRIX  IS  CALCULATED. 

DO  45  I > l.ICCT 
KKsO 

ICLS=IPLACE(I)  , ^ , 

IFdCLS.GT.LNCAT)  60  TO  45 
no  40  JsI.NOFEAT 
DO  40  K=1.J 
KKsKK  ^ 1 

C0vaR(KK.ICLS)sC0VAR(KK.1CLS)*C(J.I)*C(K.I) 

40  CONTINUE 
45  CONTINUE 
IRC=!RC-1 

IF  (IRC.GT.O)  GO  TO  20 
DO  50  Isl.LNCAT 
IF(Nd)  .£0.0)60  TO  50 
KKrO 

no  50  JsI.NOFEAT 
DO  50  Ksl.j 
KK  *KK  ^ 1 

COVAR(KK.I>sCOVAR(KK.I)/N(I)  - ME ANS (M . I ) *ME ANS ( J.  I ) 


c* 


c* 

c* 

c* 

€• 

30 


COVOOOlO 
COV00020 
COV00030 
OV00040 
^OVOOOSO 
COV00060 
COV00070 

covoooso 

COV00090 

COVOOlOO 

COVOOllO 

covooizp 

covooiao 

covooUp 

COV00150 

COV00160 

COV00170 

COVOOIRO 

COV00190 

COV00200 

covooHp 

COV00220 

COV00230 

COV00240 

COV00250 

COV00260 

COV00270 

COV002B0 

COV00290 

COV00300 

COV00310 

COV00320 

COV00330 

COV00340 

COV00350 

COV00360 

COV00370 

COV00380 

COV00390 

COV00400 

COV00410 

COV00420 

COV00430 

COV00440 

COV00450 

COV00460 

COV00470 

COV00480 

COV00490 

COV00500 

COV00510 

COV00520 

COV00530 

COV00540 

COV00550 

COV00560 

COV00570 

COV00580 

COV00590 

COVOObOO 

COV00610 

COV00620 

COV00630 

COV00640 

COV00650 

COV00660 

COV00670 

COV00680 

COV00690 

COV00700 

COV00710 

COV00720 

COV00730 

COV007A0 

COV00750 

COV00760 


>1LF:  crvtRi 


50  CONTINUE 

1ACEPT»PMIN*N0FEAT 
1E(1ACEPT.LT.N0FEAT)60  to  58 

CHECK  FOR  SINGULAR  COVARIANCE  MATRIX 


51 

C 

C 

C 

52 


I- 

160 

C 


55 


00  51  IsltLNCAT 

CALL  CHLOET(COVAR(liI) .NOFEAT»DUMMtOET) 
Yf<DET.LT.T0L)G0  to  52 

continue 

60  TO  58 

delete  singular  covariance  matrix  cluster 

WRITE (6*160) I 
IF(LNCAT.EO.l)CALL  CMERR 
IBAOsl 

LNCATaLNCAT-1 

LLNCAT=LLNCAT-1 

DO  53  II=I.LNCAT 

no  53  111=1. NOFEAT 

MF  ANS ( 1 1 1 , f I ) =M£ ANS ( 1 1 1 . 1 1 ♦ I ) 

CONTINUE 

RETURN 

F0RMAT(2X,»CLU5TER*.I5.»  DELETED  FOR  SINGULARITY* > 
1F(STATKY.NE.1)RETURN 
WRITE  (6. HEAD) 

WRITE(6.150)CLSNAM 
DO  50  Isl.LNCAT 
WRITE  (6,9(1)  I 
DO  70  L0C=1, NOFEAT. 12 
IST0P=L0C*11 

IF  1 15TOP.6T.NOFF AT) ISTOPsNOFEAT 
WRITE(6,1A0) (CH.FETVEC(J) .JsLOC.ISTOP) 
n = i 
KINC=1 

DO  60  J=LOC. NOFEAT 

K=J*(J*l)/2-Il.l 

JK=K*KINC-1 

WRITE (6. 100) (COVAR(M.I) *M=K*JK) 

II=II*1 


COV00770 

COV0078O 

COV00790 

COV00600 

COV00810 

COV0O82O 

COV00830 

COV003AO 

COV00850 

COV00860 

COV0087O 

COV00880 

COV00690 

COV00900 

COV00910 

COV00920 

COV00930 

COV009AO 

COV00950 

COV0O96O 

COV00970 

COV00980 

COV00990 

COVOIOOO 

covoiolo 

COV01020 
COV01030 
COVOIOAO 
COV0I05O 
COV01060 
COV01070 
COV01080 
C0V01090 
COVOl 100 

covo! 1 10 

COVOl 120 
COV01130 
CCVOl 1*0 
C0V01150 
COV01160 
COVOl 170 


60 

IF (K INC. LT. I STOP. ANO.KINC.lt, 12 )KINC=K INC* 1 

COV01180 

WRITE  (6,110) 

COVOl 190 

70 

CONTINUE 

COV01200 

80 

continue 

COV01210 

RETURN 

C0V01220 

90 

format (//•  COVARIANCE  MATRIX  FOR  CLUSTER*.!*/) 

COV01230 

100 

format (/6X,12F9. 2) 

COV01240 

110 

format (///) 

COV01250 

120 

format ( IHl ) 

COV01260 

1*0 

format (9X , 12( A3. 12, • ) • ,3X) ) 

COV01270 

150 

FORHaK/*  COVARIANCES  FOR  CLASS*  *2X,A*//> 

COV01280 

END 

COV01290 

3^ 


file I ISOOAT 


S'JBRpUT|NF 


8 

CMS 360 
CMS360 
C 


- lSODAT(CtlPLACE»MEANS«NfSTO£V»CLt)»FLDINF»AVP»AMN) 

IMPLICIT  INTFGEP  (A-zT 
IMPLICIT  INTEGER  (A-Z) 
iNCLUOe  COMPKStLlST 
INCLUDE  COMbK6»LlST 


INCLUDE  CMRKl6tLIST 

COMMON/PASS/STOP *LNCAttNMIN,KRNtSTOMAX*DLMINtSEP* 


MAPtSPTRIG* 


IRO.  KPTSt  NOPTSt  PUNCH* 


ICHN*CHNTHS«ICHAIN(6?) ,NWDS.IPEGIN,REGIN1« 

3EGIN?.BEGlN3.CLSNAM,NOEL0.1Pt»TOTWRO.TOTPIS. 


# 

* NCLASS^WOCLS»ToTSUR»tOtFLOftOTVRTfNOCL»NVRt' 

• fNXTCLSfNOFEftT^MAXCLSfFFTVeCOO)  tSYMMTX<62) 
•*y^?517*STATKY#ISOKEY*MAPFMT*MAPKEY*SEQyENj2p)  ♦PEPCENtSlMM^ 


ILE.INITm,PMIN*5UBVEC<62).NOSU&2.CHNVC(30) 
5EQ  i me  ANDO  » ME.  ANbU  * 


CSEND 


lOPOFR* INUNIT. INF  I 

. NOCHAN. FPC0WP.K0S__ 

SYMDO.SYMDM, itrigo.itrigu.doelag, 

* OUFLAG.OOOU.STOOTS(hO) *NSnnTS.SUNCOR(30) .LLNCAT* 

* DVERT(2Sn.2) ,UHECT(60.2»  *DVPNT « 1 1 *2> ♦ IDCNT (2) »N00U(2) 

* .MXFFTl.MAXPOP 
real  SUNCnP 

C0MM0N/GLO9AL/HEA0 (63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY* 

* MisFiL. HI skey.tmform.eriptp.erpkey.mapunt. nofile. 

* DRUMAO.nRMWDS.PAGSlZ.OATFlL.STAFIL.ASAV.ASAVFL 

* »NHSTLIN,NHSTFI.5CTRUN.MAPFIL 

* .DOTUNT.DOTFIl.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT* 

* CPOUNT.PPTUNT.HANOIO 

COMMON/ 1 SOLNK/SUN ANG ( 8 ) . ISUNT ♦ I SUNC .SMSTR . SMSTP  * SM INC  *L INSKP 


EOUIVALFNCE  (‘^GMIN.STDMAX) 

PEAL  MEANS.STOEV.STOMAX.SEP.AVP.C.AMN.SGMA.RND. 
*TEST.DmIN.0LMTN*CLO.TIME.PERCEN»0IJ 
PEAL  F.SUm,ESOT.MEAN(30.62)  «SDIJ 
LOGICAL  DEL 

DIMENSION  AVP(NOFEAT.mAXCLS) *ISGMA(62) 


c(noffat.nopts)  .iplacf:(nopts) 
AHN(NOFEAT.MAXCLS) .SGMfc(62> 
MFArjS(NOFEAT.MAXCLS)  .N(mAXCLS) 
STDEV(NUFEAT»MAXCLS) .CLO(MAXCLS*MAXCLS) 
FLOINF(I) 


C* 

C* 

c* 


dimension 
dimension 

HI  MENS  I ON 
IMFNSION 
DIMENSION 
PEAL  SOUM 
DIMENSION  PTR(62) 

DATA  SS/'S'/.CC/'C‘/ 

EOUIVALENCE  (KUIM, NOFEAT) . (LNCAT. INCAT) 

DEL*. False. 

ISFQ*0 

MAXCL  = MAXCLS  - dodo 
iniiM=i.NCAT*onr)u-MAxCLS 

ir (IDUM.GT.rt)  LNCAT=LNCAT-IDUM 

iSTOP=STOP 

SPLFINsO 

KKT*1 

DO  5 I = 1*30 
SUNCOP(I)  s 1, 

IF  (ISIINC.NE.O. OR. ISUNT. NE.O)  CALL  SUNFAC (SUNCOR.SUNANG* 
» FETVEC. NOFEAT. ISUNC. ISUNT) 


LX=K 

ASSIGN 


DATA  TO  CLUSTERS 


10 


12 


II 

II 


C 

c 

c 

c 


15 


120 


CONTINUE 

LLNCAT  = LNCAT  ♦ OODU 
IF(OOFLAG.EO.n)  GO  TO 
DO  11  J=l. NOFEAT 
means ( J. LNCAT* 1)=ME ANDO 
IF(DUFLAG.EO.O)  GO  TO  K 
DO  13  J*l. nofeat 
means  (J.LI-NCAT)  a MEANDU 

continue 

DO  15  Ksl. LLNCAT 
DO  15  J=l. NOFEAT 
MEAN(J.K)  = MFANSU.K) 

IF  (LNCAT. LF. ) .AND. KKT.GT.l ) GO  TO  530 

CALL  PSPLIT (MEANS.STDEV.N.CLO.C. I PL ACE. AVP.AMN. MEANS) 

CALL  CLnCK{TTMt) 

IF  (MOD(KKT.KPN)  .E().0)WPI  E ( »S . ) 2f> ) KK  T » T I ME 
EOOMAT  (•  rUMlllATIVE  riME  AFTER  ASSIGNING  DATA  TO  CLUSTERS 
•ATI0N».I4.»  ISI.F10.6) 


FOR 


ISOOOOIO 
S000020 
IS000030 
SOOOQ4Q 
SOOOOSO 
SOUO06O 
[S000070 
SOOOOSO 
[S000090 

isooolpo 

SOOO) 

tsooo 

[SOOO 

isoool  _ 

SO00I50 
S00016Q 
5000170 
S000180 
S000190 
1S000200 
S000210 
S000220 
SOO0230 
[S000240 
IS000250 
S000260 
S000270 
S000280 
S000290 
S000300 

soooHo 

IS000320 
[SOO0330 
[S000340 
[S000350 
[S000360 
S000370 
S000380 
[S000390 
S000400 
S000410 
[S000420 
[S000430 
S00044C 
IS000450 
IS000460 
1S000470 
S000460 
S000490 
S000500 
S000510 
S000520 
S000530 
S000540 
S000550 
S000560 
S000570 
S000580 
S000590 
S000600 
IS000610 
S000620 
S000630 
S000640 
S000650 
S000660 
1S000670 
ISOC0680 
IS000690 
IS000700 
IS000710 
1S000720 
15000730 
1S000740 
1S000750 
15000760 
IS000770 
ITERISOO0780 
IS000790 


FILEJ  ISOOAT 


132 


133 

c* 

135 

8: 

c« 


TFtEPCOMP.NE.DGO  TO  135 
ESUHsO.O 

no  132  Jal»NOFEAT 
DO  13?  K=i.LNCAT 

FSUMsFSUM^MK)  • (STOEV  < J*K) » **2/TOTPTS 
CONTINUE 

ESOTsSOPT (ESUH/NOFEAT) 

WRITE  ('>.133)  ESOT.PERCEN.STOMAX 

format (IX,///*  ERCOMPs  t,F7.3,*  PERCEN  « •,F5.3»*  STOMAX  » 
•FT. 3/) 

CALCULATE  DISTANCES  BETWEEN  CLUSTER  CENTERS 
CALL  CLDIST(CLOVSTOEV, MEANS) 

IF  STOP  EQUALS  ZERO  DELETE  SMALL  CLUSTERS 
LNCAT»LLNCAT 


140 


^F^  < ( KKT  • M AP ) > 1 50 , 1 ff 0 , 1 50. 


C 

C 

C 


,ALL  PRINT (KKT.IPLACE.MEANS.STOEV.CLO.FLOINF.N) 
GO  TO  161 
150  If  (MOD(KKT.KRN) ) 161,160,161 

160  jPLj^CE, MEANS, ST0EV,CL0,FL01NF,N) 

161  CONTINUF 
LNCAT=LLNCAT-OOOU 

IF(ISTOP.EQ.O)60  TO  162 

FOR  ITERATION  N CHECK  N(K)  AGAINST  PMIN  ♦ NOFEAT 


IF  (ISFQ  ,NE.  NOSEQ)  GO  TO  169 
ISTOP  = 0 

162  DO  163  K = l.LNCAT 

IF  (N(K)  - (PMIN  ♦ NOFEAT))  167,163,163 

163  CONTINUE 

IF  (.NOT. DEL)  RETURN 
DO  16<*  KK  = 1,LLNCAT 
no  164  KXK=1 .NOFEAT 

164  means (KKK.KK)  s MEAN(KKK.KK) 

CALL  PSPL IT (MEANS, STDEV.N.CLD.C, IPLACE.AVP.AMN, MEANS) 

DO  165  KKsl.LLNCAT 
DO  165  KKK=1,N0FFAT 

165  MEAN(KKK.KK)  = MEANS(KKK,KK) 

CALL  CLOIST(CLO.STDEV, MEANS) 

RETURN 

167  WRITE (6,168) K.N(K) .PMIN, NOFEAT 

168  FORMAT)/*  CLUSTFH'.13, * REMOVED  FOR  HAVING  ONLY*. 16,*  POINTS.*/ 
**  MIN,  POINTS  IS  (*,I4,*  ♦ *,I2,*)*) 

RETFsI 

LK=K 

60  TO  570 
171  K=LK 

DEL  » .TRUE. 

GO  TO  162 

169  CONTINUE 

170  CONTINUE 

: ON  ITERATIONS  1 THRU  N-l  CHECK  N(K)  AGAINST  NMIN 


00  180  K=l, INCAT 
IF  (N(K)-NMIN)  190,180,180 
180  CONTINUE 

IF (DEL) CALL  CLDIST (CLO.STDEV, MEANS) 

GO  TO  ?20 

90  IF  (M00(KKT,KRN) ) 200,195,200 
WRITE  (6,210)K.N(K) ,NMIN 
RETF=? 

LKsK 

GO  TO  s/n 
K-LK 

DELs.TRUE. 

GO  TO  170 

210  FORMATCO  CLUSTER  *.I2,»  REMOVED  FOR  HAVING  ONLY  *,I6, 


I95 

200 

201 


8 

c* 


2 • elements.  MIN.  NO.  elements  IS  *' 

220  CONTINUE 


16) 


soooaoQ 

S000810 

5000620 

S00083Q 

SQ00840 

S000850 

S000860 

S000870 

5000880 

S000890 

S000900 

5000915 

S000920 

S000930 

S000940 

S000955 

S00096Q 

S000970 

S000980 


S000990 


ISOO 

[000 

isoc 

010 

soo 

020 

ISOO 

) 

>30 

(SOO 

040 

[soo 

,( 

150 

ISOO 

,( 

160 

[SOO 

( 

170 

Isoo 

) 

>80 

(SOO 

090 

isoo 

00 

[soo 

ISOO) 

t® 

isoo 

isoo 

I 

1 

30 

140 

(soo 

50 

ISOO 

60 

ISOO 

. 

70 

isoo 

, 

80 

[soo 

90 

isoo 

>00 

isoo 

10 

soo 

220 

[soo 

230 

ISOO 

240 

1500 

250 

ISOO 

260 

1500 

270 

soo 

280 

[soo 

290 

[SOO 

300 

isoo 

isool 

ins 

SPLIT  ITERATION 


IS001330 
15001340 
1S001350 
1S001360 
1S001370 
IS001380 
IS001390 
IS001400 
IS001410 
IS001420 
ISOO 1430 
IS001440 
IS001450 
1S001460 
IS001470 
15001480 
IS001490 
IS001500 
1SO01510 
ISO01520 
IS001530 
IS001540 
ISOO1550 
IS001560 
1S001570 
1S001580 


ooonr>  ono 


FILE!  ISOOAT 


225 


00  225 
PTR(I»b 


si, incat 


s: 

c» 


240 

2S0 

260 


503 

502 


270 

28C 

290 

300 

310 


320 


330 


340 


350 

360 

370 

380 


ISPLTsO 

00  260  Ksl, INCAT 

FINO  MAXIMUM  STANDARD  DEVIATION  PER  CLUSTER 

SGMA(K)  > 0. 

DO  250  J » I. NOFEAT 

SOUM  = STOEV( J,K)*5UNC0R(J) 

!F  (SDUM  - SGMA(K)»  250*240,240 
ISGMA(K)  > J 
SGMA(K»  » SOUM 

continue 

•6^»ST0MAX)  1SPLT»ISPLT*1 

CONTINUE 

IF  (2«LNC4T.GT.maxCU  CALL0ESCEN<S6MA,LNCAT,ISGMA,PTR» 
TFST=FL0AT ( I5PLT) /FLOAT (LNCAT) 

IF<TEST.lF.PERCEN)SPLFIN*I 
IF  (KKT  ,GT.  ISTOP)  SPLFIN  * 1 
IF  (SPLFIN  ,E0.  0)  GO  TO  270 
IF  (M00(KKT,KRN»  .EQ.  01  WR1TE(6,503) 

F ORMAT ( /) 

IF (MOO (KKT. KPN) .EO.O) WRITE (6,502) 

format nx, 'USER  input*split-com8ine  sequence  of  iterations*) 

IF  (SFOUFN(ISFQ) .EO.SS)  GO  TO  270 
IF  (SFOUFN(ISEO) .EQ.CC)  GO  TO  410 

IS  SPLITTING  PEOUIRED 

K=1 

NCATsINCAT 

IF  (K-NCAT)  290,290,500 

IF  (STOMAX-SGma(K) ) 300.300,310 

IF  (N(K)-(nmIN*NMIN*2) ) 310,310,320 

K=K*1 

GO  TO  280 

SPLIT  CLUSTER  K 

TRIG1»1 

0EL=.TRUE. 

KX=ISGMA (K) 

INCAT=INCAT*1 
LI  NCAT=LLNCAT*1 

IF (LLNCat.LF.waxCLS)  GO  TO  350 
IF  (MOn(KKT,KP''J)  .EO.O)  WRITE  (6, 340)  KKT 
FORMAT (/•  m/uimum  CLUSTERS  ON  ITERAT ION* , I4/» 

•UT  NOT  PERFORMED*/) 

LNCAT  = MAXCL 
LLNCATsMAXCLS 
GO  TO  500 
INC=INCAT 
LL=PTR(K) 

DO  370  I=1,KDIH 
AMN(I,INr)=AMN(I,LL) 

AMN(KX,LI  ) =AMN(KX.LL) ♦5EP*SGMA(K) 

AMN(KX, IMC) =AMN(KX, INC) -SFP*SGMA (K) 


SPLITTING  REQUIRED 


SGMA (K) =0.0 
IF  (MOn(KKT.KRN) ) 400,401,400 
401  WRITF(6,390)LL,KX.INC 

390  FORMAT(*0  cluster  *,I2,*  IS  SPLIT  IN  THE  *, 12, *TM  PARAMETER  INTO  C 
2LUSTFR  i,T2) 

400  CONTINUE 


K=K*I 
GO  TO 


280 


EVEN  ITERATION 

ARE  CLUSTERS  TO  BE  COMBINED 

410  CONTINUE 

00  405  L’ 

^405  PTR(L)=I 

NOCOMRsO 


S001590 

S001600 

5001610 

S001620 

S001630 

SO01640 

S001650 

500)660 

500)670 

S001680 

5001690 

001700 


5001360 
500)870 
S001880 
500)890 
500)900 
5001910 
500)920 
S001930 
S001940 
S001950 
5001960 
500)970 
S001980 
5001990 
5002000 
S002010 
S002020 
S002030 
S002040 
S002050 
5002060 
5002070 
S002080 
B)SU02090 
S002)00 
5002110 
5002120 
5002)30 
5002)40 
5002150 
5002160 
5002)70 
5002)80 
5U02190 
5002200 
5002210 
5002220 
5002230 
5002240 
5002250 
5002260 
5002270 
5002280 
S002290 
SO02J00 
5002310 
5002320 
5002330 
5002340 
5002350 
IS002360 
SO02370 


FILCt  ISOOAT 


A06 


^NOJLST«LNCAT-l 


i 

C 


c 

c 

c 


NiELl^rc«^sv"' 

KK>0 

OHINbOLHIN 
00  430  IbIiNOCLTR 

IF(PTR(I) ,EQ.O)GO  TO  430 

OQ  425  JsII.LNCAT 


lP(P?'?(j)  IloVoGO  TO  425 
SOU  « P.O 
00  420 


420 


4?5 

430 


SOI^iSO 


p:\w 


460 


461 


KDIH 

. amn(jj.i)-amnuj»j)  )**2/«sTDEV(jjf n*sToev(jj»jn  > 

continue 

OIJsSOWT(SOU» 

IF(0IJ.GT.0MIN»60  TO  425 

OMlNsOlJ 

KK*I 

KKKbJ 

CONTINUE 

CONTINUE 

IF(KK,EO.O»GO  TO  480 
PTR(KK)*0 

COMBINE  CLUSTERS  KK  AND  KKK 
OELb.TRUF. 

RN0»1,0  /FlOAT(N(KK) ♦N(KKK)) 

00  460  KsltKOlM 

AMN(KtKK)3(N(KK)**AMN<KtKK)  ♦N(KKK)*AMN(KtKKK»  )*RND 
RETF*3 


LKsKKK 
GO  TO  570 


kkk 

IF  (KKK.EO. (LNCAT»1) ) 
MOVE  POINTERS  UP 


GO  TO  435 


DO  175  KsKKK.LNCAT 
175  PTR(K)  = PTR(K*1) 

'435  TF(M0D(KKT*KRN) )440t441,440 
441  WRITE (4»4P0)KK. KKK. KK 

440  IF  (L.LT.NOCLSTJ  GO  TO  406 


ISSillS 


5002430 

S002440 

S0Q245Q 

5002460 

S002470 

5002480 

SO02490 

5002500 

5002510 

IoeIL. 

S0025SO 

S002560 

5002570 

5002580 

5002590 

5002600 

5002610 

5002620 

5002630 

S002640 

5002650 

5002660 

5002670 

5002680 


480  CONTINUE 
490  format (•  CLUSTERS 
2ER  *.I2) 

C* 

C«  REINITIALIZE 

C* 

500  CONTINUE 

00  510  Jsl.MAXCLS 
SGMA(J)=0,0 
ISGMA ( J) an 
on  510  K=1,K0IM 
AVP (K.J) =0.0 
STDEV (K. J) =0.0 
MFANSIK.J) =AMN(K.J) 
AMN(K.J)=0.0 
510  CONTINUE 
KKTsKKT*! 

OFL*. false. 

GO  TO  10 
C 

530  IF  (KKT.NF.2)  go  TO  550 
WPiTt  (6. can) 

5..0  FORMAT  (•  THk  ORIGINAL  CLUSTER 

•lue  for  stoma*'/) 

KKT  = 1 
ISTOP=0 
GO  TO  10 


'.I2.»  AND  '.I2t*  HAVE  BEEN  COMBINED  INTO  CLUST 


isSoIti 

S002720 
5002730 
5002740 
ISO02750 
IS002760 
15002770 
lSO0|780 
IS002790 
IS002800 
15002810 
15002820 
IS002830 
IS002840 
5002850 
SOO206O 
S002870 
S002880 
S002890 
S002900 
SO02910 
IS002920 
I8O02930 
S002940 
S002950 
IS002960 
1S002970 
1SOO2980 
IS002990 
ISO03000 
15003010 
ISO03020 
15003030 
15003040 
1SO03050 
IS003060 
15003070 
15003080 
15O03090 
15003100 
15003110 

WAS  NOT  SPLIT  - examine  THE  INPUT  VAI5O03120 

15O03130 

ISOO3140 

15003150 

IS003160 


FILE!  I!(OOAT 


§52  g^ITE.<6»*i60)KKT 

’•!<».•  ITERATIONS  ALL  DATA  HAS  BEEN  ASSIGNED  TO  0 

KtCT«I  ^ 
jSTQP*0 

S70  CONT?NU? 


ROUTINE  TO  DELETE  A CLUSTER 

incat«incat-i 

LLNCAT«LLNCAt-l 

*L‘k?}fO*‘*'^‘‘*T*|).ANO,OODU.EO. 
2S  ISl  J«lk,llncat 

00  55?  L«1»K0Ih 
AMN(LtJ)»*MNlL»J*l) 

MEANS  (LfJ»«MPANS(LfJ*P 
MEAN(LtJ)  > MEAN(L«J«I) 
ST0EV(L«J)«ST0EV(L*J«1) 
NTj)»N(J*l) 

CONTINUE 

^GO  TO  (l71»20lf46n«RETF 


0)  GO  TO  (171t201«46n  *RETF 


FILE  I PSFLIT 


f M?L?C 1 J HE 4NS ♦ STOE V ♦ N ♦ CLO . C ♦ I PLACE » A VP ♦ AMN. MEN  > 

INCLUDE  COMRK'i.LIST 

Include  CMBKift.Llst.  ^ . 

COMMON/PASS/SrOP*LNCAT«NHlNtKON«STOMAXfDLMlN»SEP* 

• HAP.S^TPir,,  IRO,  KPTS*  NOPTS*  PUNCH, 

• ICHN,CHNTHS«1CHAIN(')2)  ,NwDS,  mEDlN«HEGiNl , 

• PEGlN2,HtStN3,CLSNAM.NOFLDf iPTfTOTvRDtTOTPTS, 

• NCLASS»N0CLS,T0TS0'.UT0TFL0.t0TVRT»N0CL,NVRY 

• ,NXTCLSiNOFFaT.MAXCLS,rETVe.C(30)  ,SYH*jT*J62r  

•»VARS|7,STATKY»|sOKEy,MAPrMT,MAPKEr,SEUUEN(20) •PEPCENtSlMERP 


•;iO«nER.lNUNlt,lNFlLE,lNlTH,PMlN»*;UBVEC<G2) , NOSUBZtCMNVC ( 30> 
<lEO,MEANnO»HEANOU» 


AG,DODU»STDOTS(AO)  fNSOOTStSUNCOROO)  .LLNCaT, 

‘ 0CNT(2) »N00U(2» 


c«eno 


20 


25 


30 

AO 


41 


42 


44 

45 

44 

47 


.N0CMAN,FRCnMP,N05_ 

SYMOO»SYMOy»ITPIGn,|TRIGU»DOFLAG, 

OyFLAG,DODU»STDOTS(40) fNSOOTStSU 
DVERT (250,2) ,DRECT(60,2) ,OVPNT ( 1 1 ,2) » I 
,MXFFfl,MAXPOP 
PEAL  StINCOR 

COMMON/ISnLNK/SUNANG(8) tlSUNT, ISUNC,SMSTR,SMSTP»SMINC,LINSKP 

DIMENSION  C(N0FEAT,N0PT5) , IPL ACE (NOPTS) , AHN(NOFEATiMAXCLS) 
DIMENSION  STnEV(NOrEAT,HAXCLS) ,CL0 (MAXCLSfMAXCLS) »N(MAXCLS) 
" MENSION  AVP (NOFEAT , MAXCLST, MEANS (NOFEAT, MAXCLS) 


REAL  MfN(NOFEAT, MAXCLS) 
REAL  Amn,STDEV,AVP,SuTST, 
DIMENSION  CSLINOO) 
real  CSUN  ^ 
real  DUM,DUMA 

OUM  s .000()1 


0IST,C,RN0, MEANS 


1^ 


F(OOFLAG.NE.O)  N(LN 
'.NE, - 


gCAT* 

•JCAT* 


1)»NOOU(OOF 


MDl^F^ * Ln6 a1  ^ * LNC AT ♦OOOU ) *NOOU (bo§U) 


N(I)i 
DO  5 J»1,N0FFAT 
AMN(J,I)«0.0 
STDEV(J,I)  « 0.0 
AVP(J,I)«0.0 

ASSIGN  DATA  TO  CLUSTERS 


aopesi»bfgini 
adres?«beg!n2 

ICCTsNOPTS 
fRC*IRO 

«KPTS 

{F(f  - ‘ - - 

IWRDS’  . , 

CALL  0PEaD(ar)RFSl  ,C»  Ik/ROS,  ISTAT) 


IF(IPC.LF.1)ICCT»KPT« 
IF(!rD.EO.O)GQ  to  40 
rDS*NOFEAT*lCCT 


ADRFS)=4nRcSl*IVROS 
IF<TSTaT.FO.) )GO  -* 


TO 

TO 

TO 


25 

40 

40 


[F(ISTAT.EO.O)GO 
IF(lSTAT.5E.O)r,0 
WRITE (4,30)isTAT 
format (•  ERROR  READING  DRUM ISTAT«*»14) 

continue 

IF  (ISHNT.EO.O.ANO.ISUNC.EO.O) 
no  49  lal.ICCT 
IF(DODU.FO.O)  GO  TO  42 
00  41  ksI.NOFEAT 
CDUM  s C(K,n 

IF  (CnuM, KE.MFANOO. AND. CDUM. NE.mEANOU) 


GO  TO  50 


CONTlMIF 

IF  (CO'iM.ro.MFANOO)  IPLACE(I)  = LNCAT  * 1 
IF  (CDum.FQ.MFANOU)  IPLACE(I)  = LNCAT  ♦ OODU 
60  TO  49 
KK»1 

SniST*10.0E*20, 

DO  46  J«l, LNCAT 
OIST*0. 

DO  44  KsI.NOFEAT 

CSUN(K)=C(K,I)  

0IST=DIST*  AHS( MEANS  (K,J)  -CSIIN(K)  ) »SUNCOR(K) 
IF  (DIST  - SniST)  45,46,46 
KK»J 

SOIST»DIST 

continue 

CONTINUE 


GO  TO  42 


'SP00030 


P 
P 

PSP00,_ 
PSP0004 
PSPOOO" 

p|p88o7ji 

pspoooic 

P|?0909< 

Pi  . 

pspgo 

PSPOO 
PSPOO 
PSPOO 
PSPOO 
PSPOO 
psooo 
PSPOO, 
PSPOO, 
PSROOl 
PSPOOl 
PSP( 

PSPC 
PSP(  _ 
PSPO0|70 
pspooIro 

PSP00290 

PSP00300 

pspooSio 
pspoq52o 
PSP00330 
PSP00340 
PSOQ0350 
PSP003eO 
PSP00370 
psP003eo 
PSPQ0390 
PSP004f ‘ 
PSP004] 
PSP0041 
PSO00430 
PSP00440 
PSPO0450 
PSP00460 
PSP00470 
PSR004R0 
PSP00490 
PSP00500 
PSODOSlO 
PSP00520 
PSP00530 
PSP00540 
PSPOOSSO 
PSP00560 
PSP00S70 
PSPOOSRO 
PSP00590 
PSP00600 
PSP006IO 
PSP00620 
PSP00630 
PSP00640 
P5P00650 
PSPO0660 
PSP00670 
PSPOO60O 
PSP00690 
PSP00700 
PSP00710 
PSP00720 
PSP00730 
PSP00740 
PSPOO750 
PSP00760 
P5P00770 
P«.P007R0 
PSP00790 


riLfI  PSPLIT 


00  KsUNOFCAT 

AMN(KfKKt«AMN(KtKK)*CSUN(KI 

AVP(K«KK)>AVP(KtKK)*CSUN(K)*«2 


CONTINUE 

on  ioo  I ■ ItlCCT 
KK*I 

inooou.co. 01^60  TO  S2 
ftO  51  K«T.NOrCAT 
C0UM«C(K*f»  . 

Jr  (COUM.NE.HCANOO.AND.COUH.NC.MEANOU)  00  TO  52 

If  I^BumIIoIm^anBuI  IptASIIll  • LnEaI  ♦ ioou 
88Nl?Ni8'’ 

KK  « 1 

581ST«10,OE»?0 
00  55  K ■ 1»N0FEAT 

S|s1**5’oI5T***Us(mEANS(K*J)  - CSUN(K»> 
!r(OIST-S01ST)60f70.70 


S01ST>0 
CONTI  NUI 
CONTI  NUI 
N<KK»«N 
IPLACEI 


KK)*| 


JPLACE(I)«KK 
00  90  K»ItNOFEAT 


AMN(Kt«<K) 

AVP(K«KK) 


jKK)  ■ 

INtlE 

iNUf 


AMN(KtKK) 

AVP(K«KK) 


:UN(K) 

»UN(K)»«2 


IFdPD.pQ.ojGo  TO  no 

CALL  RwRITE(AD9ES?.!pLACE.ICCT.!STAT) 
AQRES?»ADRES?*ICCT 
IF<I5TaT.EO,1)60  to  105 
|RC«1RC-1 

IFnfiC.GT.OIGO  TO  20 
KA  > 1 

continue 

no  130  k«ka.lncat 
IF(N(K) ,EO.O)fiO  TO  130 
RN0*FL0AT(N«K» > 

00  110  J»1,N0F£AT 
«MN( J.K) >AHN( J«K1/RN0 
MFAN$(  J^tO»AM^J(  j,K) 

ST0FV(  JiK)«SOrtT«AVP(J»K»/RNO-AMNUtK)»AMN(JfK)  I 
DUMA  ■ «;TnEV(J«K» 

IF  (OUMA.LT.DUHt  STOEVUtK)  • OUH 

continue 

RETURN 

ENO 


PLACE. ICCT. 1ST AT) 


TO  105 


STDEVU.K) 


pile:  f*OOATA 


C* 

c» 

r« 

c* 


r, 

C 


CIiEnO 


c« 

c* 

c* 

r* 


C* 

f« 

r« 

c« 

c* 

c* 

c* 

r* 


€• 

c« 

c« 

€• 


1 


<» 


THIS  SilhPOiiTlMt  COQ■»DI^ATES  THE  WOtjTINrs  TO  *<tAD  FltLOb  OF  iiATA 
MOH  tHF  TAK  AMO  StOwE  It  On  « D‘*Um  FILE  FOtt 

The  ISOCLS  -OtITiNFS, 


SUHPOUTInF  ^nriATA(  A.»^AY«T0P«  IHATA.  niM.LAST  ) 

I-’PLlCn  iNTFOt'O  {A-7) 

t)T«FN«.10N  »-*»AT<TOH)  .f  LOINF  (ft>  , I()ATA(  lUlM)  tFLUa)  .LSTAT  <3) 
i»jcuinF  roH"iK«i,LisT 
r'CL'JOF  CO-i'->f‘;*LlST 

COmmON/F  a‘55/STOP»LNC»T  .NHINtK«N.STr)M4**nLHlN.SEP* 

«HTS»  NOPTSt  PUNCH. 

ICHN.CMNTrtS.  IrHAlN  (h<»)  .W.'i)S,  I -JFO  I -ttU  I N 1 * 

‘<tr,iN/».ttr,iN;ur.i.«;N4M,N,)f  lo.  Ipt  . toTwpd.totpts. 

'iCLASb.'"OC!  S ■ Ti'TMI-<.T'jTFLu.TH  vwT  .NOCL.NVPT 
.N*TCL‘^.*'OPP  AT.*«4<CL^»^  ‘^TV»  C Od)  ,ST  V‘T*  <Otf) 

.VAwSI/.STAT-^V  . ISO^FY.-'AHf  MT  ,*  f,^KFY  «StUUtN(  <?0)  . f EHCKN  • S I MF«P 
, ini'f  FO.  p.,1  jIT.  InF  lu  * lHlT’'.Hr.I'j,c;yrtvtC  (0^)  . N0SUH2»Cr'NVC  ( 30 ) 
.NOrMAIj.FHrO>-  P.NOSFO.mF  AlvOO.^^t  ANOU. 

SYi'f'n,sY*‘'iii,  lTr>I  ■■.0.  I lwlOU.f^OFL»(i. 

ntiFi  rti.noiiU.STDOTF  (0(1)  .ns  'ots.suncoh  ( 10)  .llnCaT. 
nvF'-'T  (;*S-  . ')  .l)->tCT  (00.^)  ..jvP.M  (11.2)  . IOCnT  (2)  »N0nu(2) 

.«XFFTI . N44P0O 
wFA|  SHnCHP 

COM^lOr  /r-LflHAL/HFAl)  (''D  .‘«APT  ftp  . 0 AT  A Pt . S AVT  4P  .rtHF  iLE.HMKtY. 

hIFFIL  .HlSnF  Y,THF<)PM.i-<lPTP.^>PntY.MAPuNT.NOFlLE. 
OPHMin.'lP  *wnS.Pft<',sl2.i)ATF  Il.STAFIl  ♦ aSav  . aSAVFL 

,*imSTi  IN,  -jHSTf  I . SCTxUiJ.’^APF  IL 

.nnTiif.T  .I'OTF  It  ,NC HPAS,  THNSFL  .HMTPf  L . H 1 STF  L .PChuNT . 

CPOUNT  .PPTII*'  l.WANDIO 

PPnMT  s 'in 
dimension  CaP()(?0) 

FOUlYALEUrF  (FLOInF  < 1 ) ,L  INSTW)  , (f  LO  I NF  ( <♦)  . S AMSTW  ) . 

(Fl01nF(?) .uInFSO) . (FlOInF(5) .SAmFNO) . 

(FlOI  iF  (3)  ,L  lA'I  JC)  , (FLOI'.'F  (^)  .SAMInC) 

DATA  LP''N/»  ( • / 

fiTMS  ,nS|(,n  l ,o(  ?)  .LOiMi  { 1 1 ,2)  . I )-i(3S)  . lOE  ( JS)  .MUlNT  (11.2), 

Op'T  ( 1 ?'i.2)  .lioi  -T  { 12.2)  .D1N(  7(  ) 

DATA  pn^.^  *p/*nTMF  •/ 

Data  niii'AMp/«iiNii).  / 

UP'FNSK'N  FLnSAV(^.  10)  .YFVTF  X (??0) 

PFSF»,VF  ?no  I lOrATIO'^S  OF'AWWAY*  fop  FIFLU  OtFINITION  InFOHmATIUN 
THE  PEmaPOKP  of  •akpAY*  is  UStU  f OH  I/O  BoFFtkS. 


CLASS  ANO  Fin  I)  InFOwmaTION  STO..En  AS  FOLLUi^S 


IN  This  class 


(NV) 


AOPftY(l)  sPlASS  nAmF 

APCAY(?)  sOESFPvEO  FOP  I'lntx  POINTFW  in  next  class  NAME 

AHCAY(Y)  FOP  N'l.  OF  CLUSTERS  ‘ ■ ' 

APWAY(S)  XNO.  OF  FIFLOS  FO-J  THIS  CLASS 
A..HAY(S)  SFI^ST  FIi-LO  I AMr  1 OH  TmIS  CLASS 
(*.)  OF  YfPTKtS  FO.V  Tils  FKLO 

(7)-(X»NV*»2)  X ACTiiftl  ^'►PTLX  NOMHtHS 
(U.ov*?)  sTuTAL  PI*FIS  I'l  fHlS  FltLO 
(o.-oyw^)  - ( 1 o.r,o;*?)  s FlOI^F  bLOCi  FoH  THIS  FIELD 
CAU  TAHHOH (nATAPF.OATFlL) 

CONT INHF 
HFSFHVsPonn 
AODhE  "^shEOINI 
1 MUF  = 1 
1 m-HOsO 


nvpt  *n 

LASTsO 
TOThUDsO 
lop  = n 
noFLA(j  = n 
O'lFi  A(j  » n 
DODo  * 0 

NI'(HI(1)  a 0 
nooin?)  r 0 
hF  IfiOXr-FsF-V*  I 
NflljFSr  Y 


wA*0lMs7OF--'f  Sf  Pv 

HmFSI/s  ma  ni'l  V ( no;  It  S»I.oF  F at  ) • ^40FLAT 

IF  (..(If  SI /.or.  iniiion  10  I 

.^FSl  wv/-uFc:f 

IF  (we  sF-'V.ol . ■«o  ) oo  lu  2 


ponoooio 

HOUUOOZO 

HII|)U0030 

HOUUOQAO 

HDOOOOSd 

H')i)000x>0 

HDuuonro 

HDUUOOHO 

HOD00O90 

PDOOOlOO 

pooaono 

Hl)l)U0l2O 

fmi)ooi30 

puuoo|x»o 

.iDOOOiSQ 
HU000160 
HOCJOC)  70 
HODOOISO 
hO(^00[90 
HODon^oo 
W0000210 
HD000220 
POU00230 
HQDon2X»0 
H00002SO 
hOOOO?60 
Wl)000270 
HOD00280 
H0DO0290 
HDU003C0 
HL)U003in 
W()D00320 
HD000330 
POOO03A0 
HDD00350 
H()D003b0 
hI)i)O0370 
Hnuo03H0 
HOU00390 
hDOOOAOO 
H0i)00<»10 
HOU00H20 
,HnL>O0i*3O 
HUO009X.0 
HUUO0<»50 
HODOOsftO 
HUDOOsTO 
PDOOOAaO 
HUO00A90 
RODOOSnO 
hDDOOSIO 
hoi)00S20 
HDOOOS30 
W0i)u0590 
HDOOOSSO 
RO')OOS60 
Hi)O00S70 
HimoosHO 
HOU00S90 
HJUOOSOO 
hOOOOSI 0 
HODOObPO 
H0O006  30 
HOOOObAO 
HOUOOoSO 
PDDOObHO 
Hn0')0S70 
H()U00o20 

Huonooso 
1*1)000700 
PhOOO  7 1 0 
Hoouo  720 
Huoun? JO 
hU1)O07hP 
**Ji)UO  7Sl 
Hi)i>U0  7AjO 
**Oi)u077fi 
w,  1)110  7hO 
H o N 0 0 7 N 0 


filf:  rdoata 


c* 

c* 

c* 


60  TO  TO 

CONTINUE 

NOFLD*0 

IPT»1 

TOTVT?»0 

IF(MOrL,F0.0)60  TO  5 

APPAY(TPT)=NXTCLS 

IPTajPT** 

WPITEC^.hfaO) 

• »IT^CS.5f»0)NXTCk.S 

READ  A field  description  FROM  CARDS. 


.AHRAY(IPT^l)  ) 


ITRIGOsl 

ITRI6U=1 

IS=2 

IS=1 


ICK  = LAPFAiKARRAYdC'T)  .ARRAY  (IRT*2)  .FLDi 
IF  (irK.MF.-  4)  GO  TO  1000 
wRht  (6.1^0) 

PFAD  (PPDMIT.ISO)  (CARD(I).  1*1. ?0) 

WRITE  (6.160)  (CARO(I).  1=1.20) 

1S(>  FOPMAT(?nfl4) 

160  FORMAT ( l*.?OA4) 
wEvVIf'D  POUnIT 
inp=ino.i 
inCNT(T0P)*0 
OVPNTd.IOP)*! 

RFAnOO.inO)  ONAME 
RFWInO  30 

IF (DNAmF.FO.DOnamF) 

IF(nNAMF.FQ.r)ilNAMK) 

I F ( PM  amK  . . DOi'j  A 'lE  ) 

IF  (IiNAmE.FD.DUNAmE) 

1M0V=1 
INDP=1 
GO  TO  S 

1000  IF(ICK.LF.n.OP.inP.LE.O)  GO  TO  1030 
IF  (inn-T(li'P)  .LT.IO)  GO  TO  102S 
WRITE (6.170) 

170  format  (/■/  • TOO  MANY  DO  OR  Ou  FIELDS  THESE  IGNORED*) 
GO  TO  S 
CONTINUE 

REAP  (RPhNiT, ISO)  (CARD(I).  1=1.20) 

WRITE  (6.160)  (CARO(I),  1*1.20) 

OEWIMO  poiimIT 

nYE"'T(TNn'/.IOP)  = ARRAYdPT  ♦ 1) 
lOLlM  * 0vFRT(INDV.I0P)*2 
DO  1010  I = ).iriLlM 
iNDVslNDv.l 

VERTFX  dOTvTP.I)=APRAYdPT*I*l) 

1010  D'^ERT  ( Ov.  IDP)  = ARkAYIIPT  ♦ I ♦ 1) 

I MOV  = IMnv  ♦ 1 

TOTVT?=TOTVT?.IOLIM 

DO  lOPn  1=1.6 

ORE CT ( I NOP . I DP ) =FLD I NF ( I ) 

10?0  iMPPalNI'P  + l 

lOCNT  ( ino)sinrM(IDP)  ♦! 

IOUV.=  IOCNT  (IDP)  .1 
nvpNT  dnuM,ioo)*lNOV 
(lO  Tf'  S 

• finished  with  DO/DU  FIELD  PROCESSING 
1030  CONTINUE 
IDRsf. 

inpp=ITP10  >*IT«IGU 
IFdfK.LT. 0)60  TO  20 
IF(irK.EO.n)f,n  TO  30 
IFlNOfL.GT.iOGO  TO  6 
»'PITF  (6.GnO) 

CALI  CMERP 
6 CONTU'IIE 

NV=AhPAY ( TPT*1 ) 

NVRT=NVrT*NV 
NOFLDsNOFI  0*1 

NSAMpr (SAMEND-SAmSTR) /SAMlNC.l 

El  nsAM=(i 

IP=IRT*2 

NO=KV-l 

no=nq-s 

IF  (tj.J.GT.s)  n0  = 5 
lP  = Il-,  ♦MO*'>  - 1 ' 

KRIIF  (6,60,)>  MOFL  0.  APR  AY  dPT)  .SAmINC.LI'MINC. 

• (LRPN.  A'^'^AYd  ).ARRAYd.l).IiIH.I£.2) 


P0000800 
RDD00810 
ROD00H20 
ROD0083Q 
KD000845 
RUU008S0 
R0000860 
RD000870 
RDU00880 
ROD00890 
RUD00900 
RDD00910 
HOD00920 
R0000930 
RDU00940 
RD0009SO 
R0OU0960 
RDD00970 
RD000980 
RDD00990 
rDOUIOOO 
RDUUlOlO 
RDD01020 
RUU01030 
RU001040 
RD001050 
RDJ01060 
kOOOlOTO 
POD01080 
ROOD 1090 
kOOOllI 


Rf)0()|| 


8 

RD001I20 
RDD01130 
RODOl 140 
R0001150 
R0001160 
KD001170 
RD001180 
RU001190 
RDQ01200 
kDi)01210 
W0001220 
RODU1230 
kl)001240 
W0001250 
RD001260 
ki')D01270 
RD0012HO 
RDD01290 
HDOol 300 
R0001310 
R0001320 
ROD01330 
RODOl 340 
RDD01350 
HODO1360 
wnonl370 
RDO01380 
RODOl 390 
WODO1400 
P0l)01410 
W0001420 
60001430 
ROO01440 
Rnooi'450 
kni)ol460 
ROUO1470 
RlJtOI  1460 
kU')0l490 
HODOlSOO 
RDO01510 
WOU01S20 
NDDU1S30 
R 000 1640 
ROJUlSSO 
WL)  JO  1 660 
RDOU1S70 
RiI'JO  1 5ri0 


PILEJ  ROOATA 


If(^».LE.O)(iO  TO  7 
in»IK*T 

- 1 

wolTt  (LPRN.ARwavcI)  .array  (1*1)  »I=1B.IE»2) 

CONTI  Ml  IF 

IF(NSAM)3*N0FFAT.GT.  IDIM)f,0  TO  90 

position  tape  fop  this  field- 

call  -FLOlMt  (FLOlKlf,,  FETVEC*N0FE  at  ) 

FLOSAMsO 

00  m line =L1NSTP.LINEND. lining 
LNO(n=n 


LN0<?) =0 
lOHP  = ? 


TO  1095 


IOFE=l 

IF  nODR.FO.O)  r,0  TO  1095 

: ROTH  DO  -'NO  mi  TRIGGERS  OFF SKIP  aPOUNO 

00  lOKO  p.Osl.IOPP 
lOL  I»'=IOCmT(InO) 

00  1050  I=1.I0LIM 
I0U'^=(I-1  )»0 
LOSTR=nu>FrT  ( inU"^* ) . INO) 

LOENli=n-FrT  (inUH*?,  T"jO) 

LOlNC  = nR£rT  (It'UM*  J,  I NO) 
on  if.ao  IT  s I OSTS.LDEnD.LOINC 
IF  ( 1 1 .Mf^  .1  INF)  GO  TO  10i*0 
LNOlIMOlri  ni)(IN0)*1 
ini)M=|  NO ( INO) 

LOOtH  inuM, INO)  = I 

io<*o  continue 
inso  continue 

inso  CONTINIIF 

IF  (LNO(l)  .EO.O.ANO.LNDdOPP)  .EO.O)  GO  TO  1095 
: NO  no  OR  OU  FOiv  This  LINE 

IFILMD( I ) .GT.D) IUHH=1 
IF(  inpo.Fo.^.aNn.Lunii:)  .GT.o)  IUEE=2 
00  1090  iMUriDdR, lOEE 
inLiR=LNO( INU) 

IF  (101.  IM.EO.O)  GO  TO  1090 

inuH=n 

OPINT(l.l)  = 1 
DRiNTd.P)  = 1 
f»0  JOHO  Isl.nLIM 
IOF  = l.Dnn  ( I , iNO) 

()v/P  = ()\(Pf,,T  ( (OF.  IMO) 

. CALL  FOLTf'T  (Ov/ERT  (0YP*1  ,IM0)  . OVE RT  ( DV°  . INO ) ,FL  .L INE  , SAMPS  ,NI ) 
NniNT(I,INO)=oI 
IF  (NI.FQ.ii)  GO  TO  1080 
00  in?n  IT=l.ul 
1070  01  NT  (Il*lnu-->,INO)=FL(II) 
inUM=IOl;M*Nl 

DPI»';T  (1*1  , IND)  r IDUM  ♦ 1 
10*^0  continue 

1090  CONTINUE 
1095  CONTINUE 

CALL  LI'irPOdnATA.ENOTAP) 

IF(FNnTAP.Eu.-l)GO  TO  80 


FIND  sample  irTERSECTS  FOR  THIS  LINE  - Nl=NO.  I 
CALL  FOLlMT  (APRAYdRT  ♦.?)  .NV  . F L . L INE  , SAmPS  »NI ) 


INTERSECTS 


STORE 


THIS  LINE  Into  OUTPUT  BUFFER 


REAL  RPPD 

FOUl  VALrMOF  (p  •'PO.  ITGuRO) 

MO0SS  = Mon (SAMS TR. SAM  INC) 

on  80  1 = 1 .•■ji.j' 

IP=(F1  d ) -Samstp) /SamINC* 1 
IF= (FL  d ♦ ) ) -s  amsTp) /Saminc* 1 
IF  (Mouse,, fiF, mod  (F  L ( n .SAHl;(C)  ) IH  = IH*1 
IF (IH.GT. TE)  GOTO  80 
IF  (IDPP.EO'.O)  uOTO  ?0S5 

IE  (I  NOdOPH)  .FQ.d.ANO.LN'DdnFE)  .Fq.O)  goto  ?055 
00  ?US0  IMI-IOhB. IDEE 
lOLlMsi  uni  INI') 

IEdnLTM.Fn.fi)  GOTO  2osn 

iosn  = i 


R0001660 
RU001670 
90001680 
RDD01690 
RD001700 
RDU01710 
RD001720 
ROD01730 
WDD01740 
RUO01750 
RDD01760 
R0001770 
RDDO1780 
ROU01790 
ROU01800 
FD001810 
RD001820 
R000i830 
wnD01840 
RUUO1850 
RDD01860 
RDU01870 
RD001880 
RDD01890 
Rii00l900 
W0001910 
KD001920 
ROO01930 
RODU1990 
RD001950 
KOU01960 
ROD01970 
H0001980 
ROU01990 
RU002000 
RDU02010 
RDU02020 
RUJ02030 
R0002040 
R0l)02050 
R0002060 
HOD02070 
RD002080 
PD002090 
•0002100 
R0002110 
R0002120 
RD002j30 
HDOU2UO 
HD002150 
RD002160 
R00021 70 
R0002180 
HOU02190 
RUU02200 
R0002210 
RDO02220 
ROJ02230 
KDU02290 
RUU02250 
kOiJ0?280 
r0Uu2270 
kUU02280 
BUU02290 
H|)Ui)2JO0 
RO  )0?310 
ROO02320 
Kl'0n2330 
RnO02340 
Rnu02350 
ROUO2360 
ROUO2370 


FILft  WDOATA 


?003 


2009 


2010 


20?() 


?0?l 
2025 
20  30 
2040 


?0=;n 

2055 


40 

60 

10 


15 


r* 

c* 

c* 

20 


MEANOnsHFeNfif) 

IFdnBB.fo.lOFE)  GOTO  2003 
IF(Hn,t.-0.2)  1D51T«2  ^ 
fF(INn.f0.2)  '<EANOO«MEANOU 
GOTO  2009 

lF(lOPa.Fo.l.AND.I0Pe.EQ,2l  SOTO  2009 

IP  ( ITPIG'I.EO.O)  GOTO  2009 

TOSITS2 

MEAMfinsMEftNO'.l 

CriNTINHF  . . 

no  2040  <rl  . IIOLIM 

NOlN=MniMT (K. INO) 

IF  (Ml'It'.FO.O)  tiOTO  2040 
nc-ihispoiNT  (K.  InO) 

DO  2010  K<  = 1 

OIN(kk)  =0TNT  (OPliV^KK-lt  INDI 
inuM=n 

1)0  2020  KK  = l.NDlMt2 

i0H( ioun) =(01n(kk)-5AM5TB)/5AMInC*1 
ir>E  ( IDO")  = 0-'lM(KK.t-l  )-5A•■15T^^/‘^4Ml^4C♦l 

IF  (►'OO<;s,ME,''OJ(0IM(KK)  .SAmINC)  ) lUd  ( IDU'^)  =IU8  ( lOUM)  ♦ 1 
CONTI NMfc 

on  203«  kksI.IDOM 

invsiDaiKK) 

IDF=1DF(KK) 

IF(in5.'-,T.IF.np.IH.GT.I0F)  GOTO  2030 

IF(ID5.uF,.I-i)  ins=I8 

IF  (IliF.DT.It  ) IDF  = IE 

IP  (!•)«;. DT.  IDF)  goto  2030 

on  2r,2S  kkk  = ID5.I0F 

NHOU  ( I'lD)  rNP'^li  (1!mD)  ♦! 

no  2023  KKKK  = 1 .r-jfjFEAT 

ni|M*-'Yl=KKK*  >j5aMD*  (KKKK-11 

IDATA  (PHivImYI  ) rMEADOD 

CONT  INIIF 

CONTIM'F 

CDNTIMMF 

IP  ( IDPIT.PO.I  .ANI).Ni)OU{lNO).GT.O)  OOFLAG=1 
IP ( IDSTT.Fu.2.AND.nD0U( InOI.GT.O)  0UFLA6=1 
CONTINMF 

OODDsnOFLAG+OMFLAG 
on  50  J=If^fIF 
Fl  0SAM=FLD5AM+1 
DO  so  K=1,IvK)FFAT 
1 '•vi)=  I 1 
0DMMY2=J*N'5A'<P*  (K-1  ) 

«^h;n=infiTA  (DIIMMY2) 

0..i'/N'Y3=«FTMn<-l*I*PD*rttJF5IZ*  ( IbUF-1 ) 

APpAY  (n(iM»-yn)  =ITG  vPO 

IF  ( I-^PD.LT, -<iirSTZ)  GOTO  50 

inT».^r  =10T  •■"^D*lYwo 


IF  (TOT  ■'■<’n.Gr.'''«ns)  GOTO  35 
fiiiMMyA=i<FT«ii''»*r'l'FS17*  ( I^-UF-1 ) 

CALI  P'U^ITP  ( AOOPES*  APPAY  (0(t'4MYH)  .5UFS12*L5T  AT  I ISUF)  ) 

ImiiF=IR'IF*i 

ADn«FS  = An''RE5*RHFST7 

IFdP.lJF.GT.'RilFS)  IGUF  = l 

IF  (LSTAT  drjtiF)  .FO.l)  (,OTO  40 

1 ■■•PI  =0 

co\timuf 

COOT  INI  IP 
CDMT IMMP 

I&T  = TPT  ♦ MV*2  ♦ 2 
APwAY  ( IPT)  =FL'"'SAM 
no  IS  Tsl  .f, 

IPT=1PT*1 

APPAY  < TPT)  =FLDINFd  ) 

idt=ipt*i 

TPdPT*30  .GT.  RESFPVIGO  TO  70 
GO  TO  5 


CLASS  NAmP  CAkO  EnCOUnTEPEO  - pppFAD  PPF.VIOUS  CAPO  TO  GFT  NAMt 


NOCl =NOf|  *1 
IF  (NftCl.  .GT.  1 ) GO  To  25 
wPAD(3n. 1 nO)NxTCLS 
PP'jilNf)  30 
GO  TO  4 


Pl)D023BO 

P0002390 

PD002400 

K00U2410 

PUUU2420 

HU002430 

PU002440 

P0002450 

PDDU2460 

HOD02470 

PUL)U24flO 

PDD02490 

RI)J02500 

WDD02S10 

. ^ rkiN .. 


k()i)02S40 
PDl)02550 
W0002560 
90002570 
H0002580 
90D02590 
R0002600 
kOoo26lO 
P0002620 
R0002630 
PD002640 
H0OU2650 
PDl)02b60 
P0002670 
Pl)002650 
P0002690 
W0002700 
P0002710 
PD002720 
POU02730 
P0002740 
WDO02750 
P0D02760 
901)02770 
90002780 
9U002790 
900U2800 
90002810 
90002820 
90002830 
90002840 
H0002850 
90002960 
90002870 
9D002880 
90U02890 
90002900 
90002910 
90002920 
90002930 
90002940 
9D002950 
90002960 
90002970 
90002980 
90002990 
PDD03000 
90003010 
90003020 
90003030 
90003040 
90003050 
pOOU  30t>0 
9DO03070 
9000 3080 
90003090 
90003100 
90UU3110 
wnjo  3120 
90U031 30 
9000 3140 
90003150 
90003160 


^18^  original  page  is 

/ 7 QiMinV 


filf 


ROOAT* 


C* 


r« 


25 


30 


CLSN4M3MXTCL5 
RFA(M30.in0>NXTCLS 
MFwiIND  30 
r,n  TO  31 

EMPTY  I AST  BUFFFW  AND 

CLSNAHikjxTCLS 

LAST«1 


RETURN  TO  PROCESS  OAT  A FOR  THIS  CLASS. 


31  TOT»>R0»TnT'VPr)*IWRr) 

IFlTQTwRO.GT.Nwns)  GOTO  35 

^UMMYr^FI^■l)X♦PUFSl^*(IBUF-l)  ^ , 

GALL  R'*-VITF  ( aOi)»FS»  AOPAY  lOUMMY)  « IWRO.LSTAT  t IBUF)  ) 

TOTPTS*!  OT  . Jll/  ^OFEAT 
IF  (TOT  -(KD*TnTDTS.LE.NR0S» return 
■W>3ITF  (fr,20  0)N>*'OS 
RFTUe»' 

wOITF  (A.2no)N'^’'OS 
CALL  CMFRd 
w?ITF_<*..300J»FSERV 
Call  Cmerp 
«»ciTF  (B.Ano) 

C'LL  CMKRR 
*T>ITF  (^.700)  miM 
Cali.  Cmfoo 
FnPK'  AT  ( lOY  . aA) 

Fop».aT(///  • OtSiGNATEO  OTHER  0»  UNIDENTIFIABLE  FIELDS  INPUT'/) 
FOHUATC  TOO  MUCH  DATA  REOUESTEO — PIXELS* (CHANNELS*! ) CANNOT 
*0*  » 1 1 0) 


35 

70 

B(A 

90 

100 

lull 

200 

300 

AOO 

SOO 

(SOO 

ASO 

700 

BOO 


Information 


FOR''AT(*  storage  pEOUIREO  For  FIElD  DEFINITION 
o THF  niMEuslON  LIMIT  OF*. IS) 

format (•  FnU-oF-TaRE  reached  before  end  of  field*) 

FORMAT (//AMX, tFlELOS  TO  HE  CLUSTERED  FOR  CL  ASS ' . 1 X . AA// 

* T3^.'SAMPLF'.TAS,*LINF'/T?'t, •FIELD  NAPE  •»  T36.  * INC.  • » 

* TAS. » lor. • .T73. • VFRTICES  (SAmplL.LInE) •/) 
format  ( 1 X.TIB.  I3.T.P?.  AA.T3h.1r.TAS.  1A.T60. 

* S(A1 ,l4. • . '.Ir.* ) *.1X)  ) 

format ( 1 X.TH0.S(ftl . Ia. • . *,Ia.  • ) • . 1 X)  ) 

format  (•  r>0  OF  pixels  TO  BF  UNPACKED  PER  SCAN  EXCEEDS  TrlE 

PN  LIMIT  OF • . 1 S ) 

')R‘tT(//  'INPUT  ERROR  - A CLASSNAME  CaPD  muST  BE 
*POl)P  OF  FIFLOS*/) 

RETURN 
END 


RDD03) 
RDQ03j 
WD003] 
R0003< 
R0003< 
HD003( 
Rt)003t,_ 
R0003240 
P0003250 
ROD03260 
RDD«3270 
rOi)03280 
KD003290 
ROU03300 
RD003310 
HD003320 
RD003330 
RDD033A0 
HDDO3.3S0 
H0003360 
R0003370 
POD033SO 
ROOD 3390 
rOOo3AQO 
RD003A10 
RDDU3920 
EXCEEPDt)03A30 
R0003AAO 


Input  BEFORE  A 


EXCEEDSR0003450 
R0003960 
R0003A70 
PDOU3A80 
PDD03490 
R0003500 
RDD03510 
RDD03520 
ROD03S30 
OIMENSIROO03SA0 
R0003550 


GP0003b60 

RD003570 

ROUO350O 

R0003590 


10 


SELECT  PROCESSOR 


FILE  SELECT 


C* 

C 


SUBROUTINE  SELECT (ARRAY.TOP) 
IMPLICIT  INTEGER  (A-H.O-Z) 


CALL  SELECT (ARRAYtTOP) 

ARRAY  - SFE  »MONTOR» 
TOP  - SFE  tMONTOR* 


PURPOSE..  COORDINATES  THE  VARIOUS  ROUTINES 
FOR  ‘FEATURE  SELECTION*  STEP 

RETURNS..  NONE 


INCLUDE  COMBKl.LIST 


CSENO 

C* 

C* 

COMMON  BLOCK 

FSL 

C» 

C» 

C* 

DEFINITIONS 

C* 

PRCKEY  - 

KEY 

c* 

1 - 

c* 

? - 

c» 

3 - 

c* 

4 - 

c* 

S - 

c* 

CRIKEY  - 

KEY 

c* 

FOR 

c* 

1 - 

c* 

? - 

c* 

3 - 

c* 

INCFET  - 

NU. 

c* 

u<;p 

c* 

INCVEC  - 

vtc 

c* 

ON 

c* 

R£P! 

c* 

I COUNT  - 

MAX 

IS  USED  ONLY  BY  THE  'SELECT*  PROCESSOR 


INDICATING  WHICH  PROCEDURE  TO  EXECUTE 

exhaustive  search 

WITHOUT  REPLACEMENT 
OAVIUON 

EVALUATE  A USER  INPUT  B-MATRIX 
EVALUATE  SPECIFIC  CHANNELS  INPUT  BY  USER 
INDICATING  WHICH  CRITERIA  IS  TO  BE  USED 
MEASURING  SEPARABILITY. 

weighted  av,  divergence 

WEIGHTED  AV,  TRANSFORMED  DIVERGENCE 
WEIGHTED  AV.  HHATTAChAkyya  distance 
OF  CHANNELS  TO  INCLUDE  IN  THE  'BEST*  SET. 

R IfJPUT  ON  THE  'INCLUDE'  CONTROL  CARD. 

TOR  containing  THE  CHAN“J»^LS  TO  HE  INCLUDEO. 
the  'INCLUDE*  CARO.  MEANINGFUL  ONLY  IE  WITHOUT 

lacement  procedure  is  executed. 

. NO.  OF  ITERATIONS  IN  DAVIOuN  PROCEDURE. 


this 


INCLUDE  C0MRK6.LIST 

DIMENSION  aRRAY(I) .SUBRAY(12000) 

DATA  SU8SIZ/12000/ 

THE  ARRAY  SUBRAY  IS  USED  IN  SELECT  FOR  VARIABLE  DIMENSIONING 
INCLUDE  COMRK7.LIST 

COMMON/ INEORM/NOCLS2.NOSU82.NOFET2.VARSZ2. TOT VT£.NOFLD2. 

AVAR?,C0VAR2.CLSID2.SUBN02.SUBDS2.FL0SV2»VERTX2. 
FETVC2O0)  .SUbVC2(7S)  .SUBPTHI7S)  .CLSVC2I60)  t 
KEPPTS(60) ,N06RP,6RPNAM(60> .GRPDEXI61). 
GRPCHKIbl) .GROUPS (124) 

COMMON/GLOBAL/HEAD (63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY. 

HI SEIL .HI SKEY.TREORM.ERIPTP.ERPKEY.MAPUNT. NOFILE. 
DRUMAO.ORMWDS.PAGSIZ.DATEIL.STAEIL.ASAV.ASAVFL 
.NHSTIJN.NHSTEI  .SCTRUN.MAPEIL 

.DOTUNT,OOTEIL.NCHPAS»TRNSEL.BMTRFL.HISTFL»PCHUNT» 

CRDUNT.PRTUNT.RANOIO 

COMMON/ESL/CEAC.TOTMSR.SFPMSP.PRCKEY.CRIKEY.INCFET* 

INCVEC (30) . IC0UNT.SETW6T.EVALBF( 100) .FETVC4C30> 
,NOEET4.VARSZ4.CORbAS.OTAB4,WGHSU.BESTVC(10l  tOIVSIZ 
.STATKY. ADRE  SO. ADRESP. AORESF, ADRSHl .ADRSH2 
INTEGER  ADRESD. ADRESP »ADRESF,AORSH1,A0RSh2. ST ATKY 
DOUBLE  precision  CFAC. TOTMSR.SEPMSR 


SELOOOlO 
SEL0002C 
SEL00030 
SEL00040 
SEL00050 
SEL00060 
SEL00070 
SELOOOBO 
SEL00090 
SELOOlOO 
SELOOJ 
SELOO 

Ift88 

ISEL00150 
SEL00160 
SEL00170 
ISEL00180 
ISEL00190 
ISEL00200 
SELOO210 
SEL00220 
SEL00230 
SEL00240 
-SELOOISO 
SEL00260 
5EL00270 
SEL00280 
SEL00290 
-SEL00300 
SEL00310 
SEL00320 
SEL00330 
5EL00340 
SEL00350 
SEL00360 
SEL00370 
5EL00380 
SEL00390 
SEL00400 
SEL00410 
SEL00420 
SEL00430 
SFL00440 
SEL00450 
SEL00460 
SEL00470 
SEL004B0 
SEL00490 
SEL00500 
SEL00510 
SEL00520 
SEL00530 
SEL00540 
SEL00550 
SEL00560 
SEL00570 
SEL00580 
SELO0S90 
SEL00600 
SEL00610 
SEL00620 
5EL00630 
SEL00640 
SEL00650 
SEL00660 
SELO0670 
SFL006B0 
5EL00690 
SEL00700 
ISEL00710 
SEL00720 

iNPUTSELoo  no 


SEL00740 

SEL007S0 

SEL00760 


;/ 


FILE  SELECT 


SETW6T  - TR16REM  INDICATING  WHETHER  OR  NOT  DEFAULT  WEIGHTS 
„ ^ ARE  TO  BE  SET, 

EVALBF  - BUFFER  CONTAINING  ALL  USER  ’EVALUATE*  REQUESTS. 

EVALBFlI)  » NO.  OF  CHANNELS  FOR  FIRST  REQUEST 
(§-N)»  A SET  OF  CHANNELS  TO  BE  EVALUATED 
(N«1)bNO.  OF  CHANNELS  ON  SECOND  REQUEST 


KBEST*  NCPASS 


IEY0331  comments  DELETED  ••••*•**••**•< 

COMMON/HESTKN/  KFPPTS(60),  IPRIORt 
DIMENSION  ILA8LX(13>»ILARLYa3) 

DIMENSION  FETVECno) 

DIMENSION  PER(G) ,INOPER(6> ,PERM(248> 
data  lNUPER/i,13*5fl*138*213,249/ 

DATA  PEHM/1,2,1,3.1.A.1»&«I.6»1*7. 

i*2«3tl,2(4«l*2*S*i*2*6«l*2t7«i,3*4tlt3t5fl»3*6*l*3fTt 
l«4*StIf4,6«i*4,7,l*5t6«l*S*7*lf6t7* 
l«2»3»4,lf2»3»5»i«2»3t6tl»2f3*7,l,2»4»S»l,2»4*6* 
l»2»4,7»l»2»t>*6»l,2tS*7»l»2f6»7»if3»4»5»l«3»4»6» 
i,3,4,7,l,3*S*6«i,3*5*7*lt3«6,7,i,4t5f6« 
j»4,5»7»i»4»6,7,l«S»6»7, 

i*2»3*4,5»l,?»3»4»6»lt2»3*4f7»l»2»3»S»6*l»2»3t5f7* 
l»2»3»6»7,l,2»4»5»6»l»2i4*S»7«l»2«4,6,7«i»2»5t6»7* 
l,3,4«5,6,I«3t4,S«7>i,3*4,6,7,l«3»S,6*7*l*4*5*6t7f 
I*2,3*4»5,6,l,2»3*4,5t7*l,2»3*4t6»7»lt2»3»5f6»7» 
l»2»4»5»6»7f If3«4»5f6»7/ 

DIMENSION  IPSCHK(ft) 

DIMENSION  FETSAV(30),FTSAV(30» 

double  precision  small 
small  » 2**35 
JTIME  = 1 
NPSAVE=0 
10  CONTINUE 

CALL  SETUP4( ARRAY, TOP, STOPFG. JTIME, SUBRAY, SUBSIZ) 
IF(STOPFG.NE.O)  go  TO  9 
IF<PRCKEY.NE,6>  GO  TO  9 
DO  6 Ul,8 

6 1PSCHK(|)  s 0 
DO  7 Isl^N0FET2 
K=(FETVC2(I)-1)/NCPASS  ♦! 

7 IPSCHK(K)  a 1 
NPASS  » 0 

DO  a 1*1, a 

8 NPASS  * NPaSS  ♦ IPSCHK(l) 

NFPPS  = N0FET2/NPASS 
IDUM  s NFPPS*NPASS 
iF(NOFET2.NE.ir)Uri)  GO  TO  90 
1F(K«EST,LT.2.0R.KBEST,6E.NPASS)  go  to  90 
N0FET4  s NFPPS*K8EST 

NFSAVE  s N0FET4 
KPASS  a K8EST 

9 CONTINUE 
JTIME  = JTIME*! 

IF (STOPFG. EO.O)GO  TO  5 
C*  SET  FETVC2  FOR  CLASSIFY 

IF  <NFSAVfc.NE.O)NOFET4»NFSAVE 
DO  4 I=1,N0FET4 
4 FETVC?(I)=FETVC4(D 

CALL  0RDER(FFTVC2,N0FET4) 

NOFET2  s N0FET4 
RETURN 
CONTINUE 


C* 

C* 

C* 


C* 

C* 

C* 

8: 


SET  AORESO  FOR  RANDOM  ACCESS  DRUM  FILE 

AORESDsDRUMAD 
JBEST  = 0 

PHFLIM — TAKE  CARF  OF  PRELIMINARIES 
COMPUTE  separability  MEASURE  AND  INTERCLASS  MEASURES  USING  ALL 


SEL00770 

SEL00780 

SEL00790 

SEL00800 

SEL00810 

SEL00820 

SCL0083S 


SELO) 
SELO 
SELOi 
SELO] 
SELO 

seloL  - 

SEL01250 
SEL0{260 
SEL01270 
SEL0l|8§ 
SCL01290 
SEL01300 
SEL0|310 
SELO 1 320 
Sic 01 330 
SEL01340 
SEL01350 
SEL01360 
SEL01370 
SEL01380 
SEL01390 
SEL01400 
SELOUr 


FEATURES,  AND  SAVE  ON  SCRATCH  FILE 
SET  DEFAULT  WEIGHTS  IF  WEIGHTS  NOT 

SBASE=1 
SlsSBASE 

SHASF=S1 *N0CLS2*VARSZ2*1 
IF(C»lKEY.NE.l) 3haSE»1 
SLEFT=SURSIZ-SBASE 


FOR  LATER  PRINTING. 
INPUT,  ALSO  COMPUTE 


IF  CRIKFYs 
•S*  MATRIX 


SEL0l4,_ 
SEL01430 
5EL01440 
SELO I 450 
SEL01460 
SEL01470 
5FLOl480 
SEL01490 
SEL01500 
SEL0I510 
SEL01520 
SEL01S30 
SEL01S40 
SEL01550 
SEL01S60 
SEL01570 
SEL01580 
SEL01590 
SEL01600 
SEL01610 
SEL01620 
SEL01630 
SEL01640 
SEL0I650 
SEL01660 
SEL01670 
SEL01680 
SEL01690 
SEL01700 
SELOI710 
SEL01720 
SFL01730 
SEL01740 
SEL0I750 
SEL01760 
SEL01770 
SEL01780 
1SEL01790 
.SEL01800 
SFL018I0 
SFL01B20 
SEL01830 
SEL01840 
SEL01H50 
SEL01B60 


FILE  SELECT 


11 


C* 

C* 

C* 

C* 

C* 

C* 

C* 


C» 

C* 

C» 


C* 

C* 

C* 

c* 


c* 

c* 

c* 

c* 


zn 


c* 

c* 

c* 

25 

C« 

C* 

C* 


CALL  P»<CLH(ARPAY(C0VAR?>  «ARPAY(AVAR2)  .ARRAY  (RTABA)  • 

ARRAY(W6HS]a) .SUBRAY(Sl) «SUBRAY(SBASE) tSLEFT) 

- ' 60 


SEL01B70 


IF(PRCKEY  ,EO.  5) 
IF(PRCKEY.EO.A)GO 
IFJPRCKEY.r- 
JHFSTaJBES 


5f?i 


6) 


60  TO 
TO  : 
GO  TO 


nfsayf«nofeta 

N0FETAs8FSTVC(JBEST> 
1F(NOFETA,LE,0)GO  to 

IF  D AVI DON  PPOCEDURE 
WITHOUT  REPLACEMENT.. 


60 

INDICATED.  FIND  BEST  SET  OF  FEATURES  BY 
IF  FIRST  GUESS  B'MATRIX  WAS  NOT  INPUT. 


12  IF(PRC«EY,NE.3)GO  TO  15 

SET  addresses  FOR  RANDOM  ACCFSS  DRUM  FILE 

ADPESP=AnRESO*OlVSIZ*2 
AnRESF=A0PESP*N0FETA*N0FET2*2 
A0RSH1=ADRF.SF*N()FET4»N0FET2»2 
ADRSH2  = ADRSHI*  «NOFET4*nOFET2*2)**2 

WAS  FIRST  GUESS  H-MATRIX  INPUT 

IFIHMKEY.EQ.DGO  to  15 

SAVPRC=3 

PRCKEY=2 


SEL02010 

SEL02020 

SEL02030 

SEL02040 

SEL02050 

SEL02C60 

SEL02070 

SEL020BO 


SELOj 

SELO< 


090 

100 


COMPUTE  RASES  FOR  ARRAYS  OF 
transformed  COVARIANCES  AND 


•BEST*  SET  OF  FEATURES 

MEANS  STORED  IN  DOUBLE  PRECISION 


15  VAPS7*=NOFET4*(NOFETA.1)/2 
COVAR4=CORRAS 

AVAR4=C0VAR4  ♦ N0CLS2*V ARSZ4*2 
C0RHS5  = AVAR4  ♦ NOCLS2  * NOFETA 
IF(CORBSS  .LE.  TOP)  GO  TO  20 
WRITE(*>.200)  CORHSS 
CALL  CmERR 


•2 


SUBHAY  STORAGE  - STORE  'S'  ARRAYS  ONLY  IF  CRIKEY*!.  STORE 
ONLY  IF  PRCKEY=3.  STORE  R-MATHlX  IF  PRCKEY»3  OR  4. 

S2=S1  ♦ NOCLS?*VARSZ2 

BUS?  ♦ N0CLS2*VARSZ4*2 

IF(CRIKEY.WE.1)H1=1 

P1=H1  ♦ N0FFT4«n0FFT2*2 

SHASE=P1  ♦ N0FfT4*N0F£T2»2 

IF(PRCKeY.»lF.3)5MASE=Pl 

IF (PHCKEY.lt. 3) SrASE=B1 

SLFFT=SUHSIZ-SBaSE 

IF(SBASE.LF.SUBS1Z)G0  TO  25 

WRITE(6.100)S8ASE 

CALL  CMERR 

PERFORM  THE  OPTIMIZATION  PROCEDURE  INDICATED  BY  PRCKEY 
GO  TO  (30. 3S. 40. 45. 85. 87) .PRCKEY 
exhaustive  search  PROCEDURE 


C* 

c* 

c* 


30  CALL  EXSRCH( ARRAY (COVAR?) . ARRAY ( AVAR2) .ARRAY (DTAB4) .ARRAY (WGHS14) 

* , ARRAY  (rOVAH4)  . ARRAY  (AVAR4)  .SlJBRAY  (SI  ) .SUBRAY  (S2)  . 

• SUBkaY (SHASE) .SLEPT) 

GO  TO  50 


C* 

C* 

C* 


WITHOUT  replacement  PROCEDURE 

35  CALL  WHRPLC (ARRAY (COVAP?) . ARRAY ( AVAR?) . ARRAY ( DTA84 ) . ARRAY (WGHS14) 

• , ARRAY (CnVAPA ) . ARR AY ( A V AR4 ) .SUBRAY (SI ) .SUBHAY (S2) . 

* SUBWAY (SBASE) .SLEPT) 

GO  TO  50 

OAVIOON  PR'TCEDUkE 


40  CALL 


DAVIDN( ARRAY (fOVAR?) . ARR A Y ( A V AR? ) , ARRAY ( DTAR4 ) . ARR A Y ( WGHS 1 4 ) 
, ARRAY (C0VAH4) , ARRAY ( AVAR 4 ) .SUBHAY  vSl ) .SUHRAY (52) 


SEL0211C 
SEL02120 
SEL02130 
SEL02140 
SEL02150 
SEL02160 
SEL02170 
SEL02i80 
SEL02190 
SEL02200 
SEL02210 
SEL02220 
SEL02230 
SEL02240 
SEL02250 
PARTIALSSEL02260 
SEL02270 
SEL02280 
SEL02290 
SEL02300 
SEL02310 
SEL02320 
SEL02330 
SFL0234O 
SEL02350 
SEL02360 
SEL02370 
SEL02380 
SEL02390 
SEL02400 
SEL02410 
SEL02420 
SEL02430 
SEL02440 
SEL024S0 
SFL02460 
SFL02470 
SEL02480 
SEL02490 
SEL02500 
SFL02S10 
5EL02520 
SEL02S30 
SPL02540 
SEL02550 
SEL02S60 
SEL02S70 
SFL02S80 
SFLn?S90 
SEL02600 
SPL02610 
SEL02620 


7^3 


FILE  SELECT 


C* 

C» 


*5 


S'-V 


USER 

CALL 


s: 

c* 


*SURRAY(Bn  «SUBRAY(P1) .SUHRAY(SRASC) tSLCFT) 

WRTBMT (SUBMAY (HI » .N0FET4.N0FET2»FETVC2) 

0 SO 

INPUT  B-MATMIX 

USERIN( ARRAY (COVAM2) « ARRAY ( AVAR2) « ARRAY (OTAB4) * ARRAY (WGHS14) 
t ARRAY (C0VAR4) * ARRAY (AVAR4) tSUBRAY (51 ) tSUBRAY (S2> 
•SUBRAY(BU •SUBRAY(SBASE)*SLEFT) 


GENERATE  REPORTS 


GENRPT ( ARRAY (CLSTDgi t ARRAY (WGHS14) «ARRAY (0TAB4) • 
‘ .SLFFT tFFTVEC) 


C* 


C* 


50  CALL  

• SUHRAY(S8ASE)  

CALL  PLOT (SURRAY (SR ASE ) .ARRAY (0TAB4) .OIVSIZ.MAXX. ILABLX. ILARLY* 

* ICOOE.IOPT) 

IF (SAVPRC.NE.3»GO  TO  11 
SAVPRCaO 
PRCKEY*3 
60  TO  20 

PERFORM  evaluate  REQUEST 

60  1V=1 

1SAVE=PRCKEY 

PRCKEYsS 

70  N0FFT4=EVALHF(IV) 

IF(NOFfT4.GT,0)GO  TO  75 

PRCKEYxISAVE 

GO  TO  10 

75  DO  eo  I=1.N0FET4 
IVsIV*! 

SO  FETVEC(I)  = EVALRF(IV) 

RENUMRERING  CHANNELS  IN  REFRENCE  TO  SUBSET  OF  CHANNELS 


;t2 

•T4 

.N£, 


FETVC2(D)  GO  TO  82 


62 


C* 

C* 

C* 


85 


87 

Rl 


00  82  1=1. NOF 
DO  82  J=1.N0F 
IF  (FETVEC(J) 

FETVC4(J)  = I 
CONTINUE 
CALL  ORDER (FETVC4.N0FET41 

GO  COMPUTE  BASE  ADDRESSES  FOR  REDUCED  ARRAYS 

GO  TO  15 
CONTINUE 

CALL  F.VLFET(ARRAY(rOVAR2»  . ARP  AY  ( AVAR2)  .ARRAY  (DTAB4)  .ARRAY  (WGHS14) 

• .ARRAY (C0VAR4) , ARRAY ( AVAR4 ) * SUBRAY ( S 11 .SUBHAY ( S2) 

• .SURRAY(SRASF) .SLEFT) 

CALL  GENRPT(aRRAY(CLS1D2» .ARRAY (WGHS14) .ARRAY (0TAB4) 

* .SUHRAY(SHASR) . SLFFT . FE TVEC ) 

CALL  PLOT ( SURRA Y (SR ASE) .ARRAY (DTAB4) .OIVSIZ.MAXX. ILABLX. ILABLY. 

* ICOOE.IOPT) 

IV=IV*1 

GO  TO  70 

BEST  K OF  N PASSES 
CONTINUE 

NCNT  = NPaSS  ♦ 1 •>  KPASS 
IDUM  s INDPER (KPASS  - 1) 

NCNTP  = (INOPER(KPASS)  - IOUM)/KPASS 
DO  9R  1=1. NCNT 
00  98  11=1. NCNTP 
DO  92  IH=1. KPASS 
IDMsIODM* ( I I-l )*KPASS*II1-1 


92 


93 

94 


G0"i 


PFR(IIl)  = PERM(IDM)  * 

IF  (PER(III) ,GT. NPASS) 
CONTINUE 

no  94  111=1. KPASS 
iDMrPEHnn) 

DO  93  nil  = l.NFPPS 
lOMA  = NFPPS* ( I I I-I ) ♦ 

IDMH  = NFPPS*  ( 10  •’-1  ) ♦ 
FFTVC4(IDMA)  a lOMR 
FFTVFC(IOMA)  a FETVC2(I0MB) 
CONTINUE 


0 97 


ilii 


SEL02630 
SCL02640 
S|L02650 
SEL0266( 
SELO  “ 
SfLO 
SEL0|6f( 


SEL027* 

SEL02760 

SEL02770 

SEL02780 

SEL02T90 

SEL02800 

SEL 02810 

SEL02820 

SEL0283 

S£L0|84 

SEL0285. 

SEL02860 

SEL0287C 

SCL02880 

5EL02890 

5FL02900 

5EL02910 

SEL02920 

SEL02930 

SEL02940 

SEL02950 

SEL02960 

SEL02970 

SEL02980 

SFL02990 

SEL03000 

SELOSOiO 

SEL03020 

SEL03030 

SEL03040 

SEL03050 

SEL03060 

5EL03070 

SEL03080 

SEL03090 

SEL03120 

SEL03130 


Ilf* 


SEL03160 

SEL03170 

SEL03180 

SEL03190 

SEL03200 

SFL03210 

SEL03220 

SEL03230 

SEL03240 

SEL03250 

SEL03260 

SEL03270 

SEL03280 

SEL03290 

SFL03300 

SEL03310 

SEL03320 

SEL03330 

SEL03340 

SFL03350 

SFL03360 

SFL03370 

SEL03380 


/ 


Of  POOR  '4 


<}OALln 


FILE  SELECT 


95 

96 


CALL  EVLFET(ARPAV(rOVA9?)  .A9PAYUVAR?)  * 

• ARRAY (DT AHA) • AWRAY (W6HS1A) * ARRAY (COVARA) f ARRAY (AVAR4) t 
« SUHRAY  (SI ) tSUriRAY  (S?>  tSUBRAY  (SBASE)  tSLEFTi 

IF  (SMALL. LT.SEPMSH)  60  TO  96 
no  95  Til  » l.NOFETA. 

FTSAV(Il!)  » FETVEC(lIl) 

FETSAV(III)  « FETVCAdIn 
small  * SEPMSR 
CONTINUE 

CALL  6ENRRT(ARRAY(CLS102) .ARRAY(RGHSIA)*  ^ 

* ARRAY (OTAHa) .SOBRAY(SBASE) fSLEFT.FETVEC) 

CONTINUE 
CONTINUE 
CONTINUE 

00  101  lal.NOFETA 
FETVEC(l)  a FTSAV(n 
FETVCa(I)  • FTSAtf(I) 

WRITE(6.1010) 

FORMAT (IMI,  ‘BEST  SEPARABILITY  MEASURE*.//) 

WRITE (6. 1000)  small 
WRTTF(6»1020) 

FORMAT (//  • CORRESPONniNG  FEATURES* »//) 

WRITE(6.1000)  (FtTVEC(l).  lal.NOFETA) 

1000  FORMAT(  ) 

GO  TO  10 

WRITE(6.250)  NOFF.TA.  (FETVC2(I)  .Ial,N0FET2) 

FORMATC  ERROR  IN  INPUT  CHANNELS* //. 1 X. 12. 30 ( IX. 12) ) 
CALL  CMERR 


97 

9B 

99 


101 

1010 


1020 


90 

250 


SEL03390 

SEL03A0Q 


SFL03A10 

SEL03A20 

SfL03A30 


SfcL03AAO 

SEL03A50 


SEL03A60 

3EL03A70 

>EL03AS5 


SEL03A9d 

SEL03500 


100  format (*  CORE  OVERFLOW 
*Y  FOR  THIS  PRORLtM*) 
200  format (•  CORE  OVERFLOW 
*R  THIS  PRORLEM*) 

END 


IN  SUBRAY-*.I6.*  STORAGE  LOCATIONS 
IN  ARRAY-*. 16.*  STORAGE  LOCATIONS 


lltSII). 

SEL035A0 
SEL03550 
SEL03560 
SFL03570 
SEL03580 
SEL0359O 
S^L03600 
5EL036]* 
SFLO' 
SFLO! 
SFL036A0 
SEL03650 
SEL03660 
NECESSARSFL03670 
SFL03680 
NEEDED  FOSEL03690 
SEL03700 
SEL03710 


FILF:  AVFOIV 


i 

r* 

c* 

c* 

c* 

r* 

c* 

c* 

c* 

r<* 

c* 


4 


(!• 


•? 

1 


? 


10 


1 7 


sn 


r* 

C« 

C* 

r* 

r* 

c* 


5U«>^0U1 INF  *ve01V(SMS»*C0VMTX.S»C0VMT2*S2»WRKRYt IWRFSZ* 
IPAHT.PARTLS.flMXTtlFULL) 

INCLUDF  COMf»«l,LlST 
INCLUDE  C0MBK7.L1ST 

COMMON/ INF0PM/N0CLS2*N0SUH2.N0FFT?*VARSZ?tT0TVT2»N0FL0?» 

AV4W?,C0VAR2«CLSI02«SUBN02tSUPnS?<FLDSV2*VEPTX2* 
FF.TVC2O0)  .Sl)MVC2(75)  .StJBPTR(7S)  .CLSVC2I60)  ♦ 
KhPPf<>(NO>  •N0GRP«6WPNAH(60)  tGRP0EX(6l)  * 

GPPCMK  (Ml.  PPOUPS  ( 124 ) 

COMMON/FSL/CFAC*TOTMSR.SfcPMSR*PHCKEYtCHIKEY»INCFET* 
iNCVECnO)  , ICOUNTtSETwGTtEVALBFnOOl  »FETVC4nO) 
.M0FFT4.V4MS74tC0RBAS*liTAB4*WGH514«HESTVC (10) *0IVSIZ 
, ST  aTi-.Y  . ADRESn  . AOPESP  , AO«FSF  . AORSHl  » A0RSH2 
T NTEGK  « AuRF  SO . AOPtSP • ADPFSF  t AORSH 1 * A0RSH2»ST ATK Y 
noUPlE  PRECISION  CFAC.TOTMSRtSEPMSR 

INTEGER  VAHS??.VAPSZ4 

SIJOROUTINF  TO  COMPUTE  WEIGHTED  AVERAGE  01 VFRGENCEt AND  PARTlALS 
WITH  respect  to  H. 

IF  IFlil.Lsl  compute  AVERAGE  DIVERGENCE  FOR  ALL  'NOFET*  CHANNELS, 
PAWTIAI.S  CANNOT  BE  COMPUTED  WHEN  IFULLal. 

IF  IPaOT=a  COMPUTE  PARTlALS  WITH  RESPECT  TO  BMAT. 


nOHELE  PRECISION  OET,SMSR»T»ACE 
nnuPLE  PRECISION  PMAT.PARTLS 
OOUPlE  precision  C0VMT2»S2»WRKRY(1) 

DIMENSION  COVMTX(VaHSZ2*NOCLS2) ♦ C0VMT2(VARSZA,N0CLS21 ♦ 

S( VARS7?»NOCLS2) t S2 (VARSZ4,N0CLS2) 

niMENSION  PARTl.S(  1 ) *0maT  ( 1 ) 

TCV  = 1 

ITPST=ICV*VAHS74 

IF  ( IFULL.  '^E.  1 ) GO  TO  4 

ISl =ICV*VAPS/2 

ITFST=IS1*VARS72 

rONTINDF 

IFdPAOT.l.T.OlGO  TO  1 
IW1=1TFST 

IW?=I  W1  ♦NOFF'TA*NOFET2 
7FR0  PARTLS 
kk=N0FFT?*NOFET4 

no  ■(  Ksi  ,«K 

PARTLS (K ) =0.0 

1TEST  = T.  ? ♦ r.0FFT4*N0FETP 

IF  n'-ir>*^S7/?.GE.  I TEST)  GO  TO  2 

WRITE  (A-.prO)  I-RKS7 

CALL  CMFRM 

r ON  T TNI  IF 

SMSP  = fi.O 

00  30  Trl.'vOfLS/ 
lEdFUl  L.EO.DGO  TO  15 
no  10  ,l=l.VnPS74 
WRSPY  ( J)  =<:OV  .'T?  ( J,  1 ) 

HFsNnEP  14 
NO  TO  17 

no  J=1.,/AHS/P 
wwRpv  ( j)  =f:(iV'Ix  ( j.  I ) 

vRKRY (IN  I *0-1) =s( j. n 
NFrIJOFFT? 

CALL  COLl'wV  (Nkkhy(  ICV)  .NF.IEPR»3»0£T) 

IF ( IFPR.F0.n)60  TO  20 
WPTTF  (F.  liiO)  I 
no  TO  To 

IF  ( IMil  L .f  1 ) S”SR=SmSR*TPACF  (wRKRY  ( ICV)  .WRKHY(  ISl ) .N0FET2) 
IF  ( lEHl  L .I'h.  1 ) SMSW=SMSW*TPACF  (wPKRY  ( I CV ) . S2  ( 1 ♦ I I .N0FFT4) 

Cn^PUTf  PAhTIALS  only  if  IPAHI  * 0. 

IF  ( IPaPT.LI.IDGO  to  30 

COMPUTF  PARTIAL  OFRIVATIVFS  WITH  RESPECT  TO  BMAT 

CAI  L MTl  (HMiT.COVMTX ( 1.1)  .WRKRY ( IWl ) . N0FET4 . NOFFT ? ) 

CAl  I.  HT  / ( rtWWMY  ( ICV  ) .WPKWY  ( IW  1 ) , wPKWY  ( IW?)  . NOFE T 4 , nOFF T ? ) 

CAI  I MT? (S? (1 . I ) .wRNPY ( IW?) .NWKRY ( IWl ) . NOFF T 4 , NOFF T ? ) 

CALL  ATI  (HMf  T.S (1 . I ) .WRKPY ( lw2) .N0FET4. NOFFT?) 


AVEOOOlO 
AVE00020 
AVE00030 
AVE00040 
AVEOOOSO 
AVE00060 
AVE00070 
AVEOOOBO 
AVEOOORO 
COHOOOlO 
COM00020 
COM00030 
COM00040 
COMOOOSO 
COM00060 
AVE00J70 
AVFOOlBO 
AWEOOiPO 
AVE00200 
AVE00210 
AVE00220 
AVE00230 
AVE00240 
Avenolso 
AVE002G0 
AVE00270 
AVE00280 
AVE00290 
AVE00300 
AVE00310 
AVE00320 
AVE00330 
AVE00340 
AVE00350 
AVE003n0 
AVE00370 
AVE003P0 
AVE00390 
AVE00400 
AVE00410 
AVE00420 
AVE00430 
AVE00440 
AVE00450 
AVE00460 
AVE00470 
AVE004R0 
AVE00490 
AVE00500 
AVE00510 
AVE00S20 
AVE00530 
AVE00540 
AVEOOSSO 
AVE00S60 
AVE00570 
AVE005H0 
AVE00S90 
AVE00600 
AVEOOMO 
AVF.OOftPO 
AVE00630 
AVE00640 
AVE006S0 
AVEOOftOO 
AVE00070 
AVEOOhHO 
AVEOOORO 
AVE00700 
AVE00710 
AVF007P0 
AVE00730 
AVE00740 
AVE007SO 
AVL00760 
AVEOO  770 
AVF.n0780 
AVE007R0 
AVEOOHOO 


FILE!  AVFOIV 


no  2S  K»l,KK 
L«K-l 

WRKRY  nwl»U  «irfRKf<Y  < 1W2*U -WRKRY  < IW1*L) 

CALL  MT2(WHKHY  (ICV)  tWRKKYdKl)  «WRKfiY(IW2)  .N0FET4 
no  2*>  Kal.KK 
L«K-1 

PARTLS(K)rW«»H«YUV»2*U  ♦PARTLS(K) 
rOWTlNUF 

SHS»  « -(CFAC*SmSP/2,  - NF> 

1F<IPaRT.LT,0)«ETU«N 

no  “io  Kal.KK 

PA0TLS(K)«-CFAC*PARTLS(K) 

PFTUPW 

FnPMflTM  kEOUCEO  covariance  RATWIX  fob  class* tI3 
* nFFiNITE') 

200  FOOMAT(*  hope  STOPAttE  NEEDED  IN  SUB,  AVEDIV  FOR 
*T2Fa*.I7) 

FNn 


30 


AO 

100 


AVEOOBIO 

AVE00B20 

AVE00H30 

«N0FET2)  AVCOOBAO 

AVE008S0 
AVE00N60 
AVE00670 
AVEOOBBO 
AVC00890 
AVE00900 
AVE00910 
AVE00920 
AVE00930 

,t  IS  NOT  POS1TIVEAVE009A0 
AVE00950 

WORK  ARRAY— WORK  SAVE00960 
AVE00970 
AVE009P0 


" n 


riLPJ  RMTCHH 


C 

C 


rUFNO 

c* 

c* 

c* 

r* 

c* 

c* 

c* 


c* 


? 


1 


c* 


<s 


c* 

c* 


SU<«MOUTINE  ^HTCH^(SMSR«C0VMTX««VEHTX*WC16HT«0IVTAB« 
COVPT2.AVEMT?* 

WRKRY* IWRKSZ* IHART*PARTLS«RMAT* IFULL) 


.URF 


TNC 
NT_  _ 
tNCLUOF 


fkfiFR 


COMBuT, 

VARSZA 
COHmk' 


IlhjvSIZ 

l.L  ST 


*VARSZ2 


COMMON/ IRFO^^H/NOCLSPtNOSUR^.NOFETZtVARS; 

AVAR?.COVAR?.CLfl02»SUHNPS 


T0TVT2»N0FI.Q2. 
LOSV2»VERT*2f 


/« lo  

.SUBPS2.FL0S 


2(60) t 

X(61) « 


F(TVC2(30)  tSlJ»VC2(7S)  ♦SUM 
KKPPTS(60) •N06RP«6RPNAM(60>  *0 
RRPCHK ( M ) . OROUPSi 1 2A ) 
rOMMON/FSL/CFAC.TnTMSRfSFPMSR«P(>CKFY»CPlKFY.lNCFeT. 

INCVFC  C^f) • ICOUNT.SFtwGT«FVALHF (100) .FFTVCA(IO) 
♦^OFtr»*VAMS7*»COHMAS,OTA«A*W6MSlA»RESTVC(10) tOlVSIZ 
.STATKY./nRFSD.AORESPiAnPESF.AOPSH) tAORSM? 

INTEGFR  Ai)WF«;D.ADRESP.AOPFSFtAORSMl»AORSH2»STATKY 
nOUHLE  PRECISION  Cf AC*TOTmSR.SEPMSA 


CUBROUTINF  TO  COMPUTE  ThE  INTEPCLAS5  BHATTACHRYYA  DISTANCE. 
THF  YEIOHTEO  AVEPAftE  DISTANCE.  AND  TmE  PAHTIALS  WITH  RESPECT 
TO  R. 

IF  IFULLal  COMPUTE  P.  DISTANCE  FOR  ALL  *NOFET»  CHANNELS. 

PAWTIALS  CANNOT  BE  COMPUTED  WHEN  IFULL*l. 


noURLE  P-TFCtRION  DI VT AH  (D1 VSI Z)  .OETl .0ET2.0ET3 
noiiPt.E  PRECISION  SMSR 
nOlIRLE  PRECISION  RMAT. 
nniiRLE  PRECISION  COVMT 
dimension  C0vmTX(vaHS7 
AVFMTX (NOFET 
Wf.  IGHT  (01  VS 

TVS7=VSRS7* 

NEaNOFFT* 

IE  ( IEIII.L.FI5.  1 ) IVS?*VAPSZ2 
lEI IEULL.EO.1 )nF*N0FET2 
TCVlal 

lCV?  = irvl*lv57 
IW1=ICV2  ♦IVSZ 
TWPalWl  *IVSZ 
ITEST=Iw?.nF 
TF( IPaRT.lt, 0)60  TO  3 
7ER0  PAWTIAI.S 
IO=NOFPT7*NOEETA 
no  ?.  IKrl.n 

PARTLS ( IK) aO.O 
Tv,3=IW?*'.0FFT? 

IW4=lw3.N0Ff T? 
tWB=IW4.MAArt( VARS72.I0) 

TWRsIwR*lR 
IWTalwA.I  -J 
lTPST  = I.'7*n 
FONT  INlIf 

!F(I^mk57/2.(’F.ITFST)GO  TO  1 

WRITT-  (<.,  ?00l  1 WRKSZ 

CALL  CPFRR 

rONTINliF 

CMSPsO 

NMsO 

TCaNOCl  S?-l 

no  Fio  1 = 1 . ir 

FIND  irJVFrtSC  aK'O  DETERMINANT  FOR  CLASS  I 
no  I<  = 1 . I ''S7 

TF  ( IFULL.f  0,  1 ) -Rr.RY  ( IK  ) =f  OV'-TX  (IK.I  J 
IF  ( I Fill  L.NE.  1 ) wwKRV(  IK)  =C0V,*iT2(  IK.  I) 
rONT  INLIF 

CAl  L cnuf  viwPKRir  ncvi ) .NF,  ifrs.t.dETI) 

nFTl  = l ./:)t  T1 

TFlITPR.F'v.'UGO  TO  6 

WHITFIK.IOO) T 

r-0  TO  KO 

Tm=IM 

no  so  Jr  IM.'IOCLS? 

MMsNw. 1 

COMPlJTF  IUV)MSf  At.u  OFTFRMINANT  FOR  CLASS  J - AND  - 
COMPUTE  ItgvFRSP  ANO  UFTERMINANT  FOR  SUM  OF  CLASSES  I AND  J 
no  in  Ik=1,IvS7 


PARTLS(l) 


2.AVFMT2.WRKRV  (1)  .TOO)  »RNUM 
2.NOCLS2) . C0VMT2(VARSZ4.N0CLS?) • 


NN0CLS2)  . 
\L\ .HMAT(l) 


AVEMT2(N0FETa,N0CLS2) t 


BHTOOOIO 
RHT00020 
bhtoooSo 
BHTOOOAO 
RHTOOOSO 
HHTQ0060 
BHT0Q070 
RhTOOOAO 
BHTOOQRO 
BHrooioo 
BHTOOllO 
NHT00120 
HHT00I30 
BHTOOlAO 
SO 
60 
170 
BHTOOIBO 
HHTOO  90 
BHT00200 
BHT00210 
BHT00220 
BHT00230 
BHT002A0 
BHT002S0 
EIHT00260 
BHT00270 
HHT002B0 
BHT00290 
BHT00300 
BHTOOliO 
BhT0o3|O 
RHT00330 
RHT003A0 
HHT00350 
RHT00360 
HHT00370 
BHT00380 
BHT00390 
BHTOOAOO 
BhTOOAIO 
BMT00420 
BHT00430 
BHT00440 
HHT00450 
BHT00460 
BHT00470 
BHT004B0 
BHT00490 
BHTOOSOO 
BHTOOSIO 
BHT00520 
RhT00530 
BHT00S40 
BHTOObSO 
RHT00S60 
BHT00S70 
(ihTOOSSO 
RHT00590 
RHT00600 
RH700610 
PHT00620 
PHT00630 
PHT00640 
RHT006S0 
rjMT00660 
BMT00670 
HHT006«0 
HHT006V0 
BMT00700 
RmTOO  710 
HHT00720 
PHT00730 
HHT00740 
PHT007S0 
hMT007N0 
RHT00770 
HHT00780 
bHT  00790 


Fltn  WMTCMR 


C 


r« 

c« 

c* 


'V  • A r w I w %r 

*!K-p«COVWT?nKtJ) 

• iK-i)>eovMT2nKtj)*covMT2( 


IK»I) 


IFtIFULL.f-i.nOO  TO  « 

wrkry(  rv2*fK-n«covw 

WRKRr(  Ml  •iK-i)BCOVM 
fiO  TO  0 
R WRKRYt  CV2*TK-n«C0VHT*nK»J) 

WRRRY  ( W 1 * 1*^-1 » «COVHTX  ( IK,  J»  *COVMTX  ( IK,  I ) 
in  CONTINUE 

^AU  COL  INV  (nRKRY  I ICV2)  ,NF,  IERR,3, 0ET2I 

nrf?*l,/OFT2 

iFriFHR. £0.0)60  TO  15 

WRITF(#,,1P0>  J 

00  TO  op 

15  CALL  COL1nv(wHKRY(1W1),NF,1ERR,3,OET3) 
OFT3«l./5En 
IFUFRB. £0.0)60  TO  16 
MPITF  (*1,200)  I,J 
00  TO  50 

1ft  IFMFULL.’^F.nfiO  TO  IR 
00  17  T^«1,^0FFT^ 

17  T(T«) «»vEpTX(IK,1)-AWEmTX(1K,J) 

60  TO  >5 

1*  no  20  tK«i.  v'OFFta 

?p  TIIK)x4vF*'T?(I><,I)  - AVEHT?(IK,J) 

“ULTTPLY  T ToansPOSE  TIHES  xRKRYl 
?5  rOxiTlNIJF 

CALL  *1T4  (,R<Br  (Itrl  ) ,T,xBKRY(!w2)  ,NF,NF,1,D 
PNMMxO.O 

no  2*.  iKsU'-'F 

QNMMsPNUP*  -*RKHY(  IW2*IK-1)*T  (IK) 
mvTAH  (N4«)3nF*B  (-.?S«»NUP  -,5«DL0G(DET3/(2*»NF 
• • f)50PT  (l)ETl*DET2) ) ) ) 

SM5RaS“SP*WElv'‘'HT  (NM)*oIvTAB(NM) 
if(IPart.lt.o)go  to  50 


COMPUTE  PA^TIALS 


30 

3S 

*0 

A1 

45 


43 


4ft 


47 

60 

ftO 


100 

?op 

300 


CALL  MT%( .k-by(Iw2) ,8maT,WRK«Y(Iw3) ,1,NOFET4,NOFFT2,0) 
no  30  lKsl,VM^S22 

WPKWY ( IK*  fw4-l ) xCOVMTX ( IK, J) *C0VMT X ( I K , I ) 

call  MT4 (►WKPy ( 1w4) ,WRKPY ( 1w3) ,WRKRY( IW2) ,N0FET2,N0FET2, 1,1) 
no  35  !k*1,N0PFT2 

WPkWY()'V3*Ik-1)sAVFMTX(IK,I)'AVEMTX(1K,J)  - W«KPY(  IW2*IK-1) 
call  **T4  (T.wPKRY  ( I«3)  ,wt*KRY  ( I W5 ) .N0FET4 , 1 ,NOFET2,0) 

CALL  MT4 ( wkKwr ( iMl ) .wPKPYdtoS) ,WPKPY( I«6) ,N0FET4,n0FFT4,N0FFT2, 1 ) 

no  40  TKsi.iij 

WPKWY ( I*ft*IK-l ) sWRKRY ( IWft*IK-l)/2 

MsT 

ICslCVl 

no  45  1Ks1,vaR5Z4 

L XTK-I 

WRKRY ( |W4*L) »KPKRV( IW1*L>-WRKRY(IC*L)/2 

CALL  »*T4 (wWKky ( Iw4) ,Hk4T,WRKRY ( I«7) ,N0FET4 .NOFF T4 .NOFE T2, 1 ) 
call  x'Tl  (kWKPY  ( lk7)  ,C0VPTX(  1 ,M)  ,i(RKRY(lW5)  ,N0FFT4,N0FET2) 
no  43  iKsl.IO 
L»I«-1 

WBKBY  ( Ikft*L  ) xkPKk  Y ( lMft*L)  *i<«KRy  ( IK5*L) 
tF  (4i.(- 0.  j)(,n  TO  kh 
“c  J 

ic=irv? 

no  TO  41 

no  47  TKsl.I^ 

I sIK-1 

PAPTL5(lK)=kAi3TLS(  I K ) -4E  1 6HT  ( NM ) *01 VT  A8  ( NM)  «wRkR Y ( I W6*L ) /N0CLS2 

rO^'TlNli* 

rONTlMir 

rONT  IN(P 

6H5WsS«Sk/fjOQ 

OPTUO'J 

FOPMOTC  oiuak  fob  CLAS5*.I3.'  IS  NOT  POSITIVE  OFFIMTE*) 

FOBMATM  C.iUAk  FOP  50**  OF  CL  ASStS  • , 2 1 4 , • IS  nOT  POSITIVE  OFF.') 
FOBMATC  OliT  ENOUGH  aORR  ARE*  AVAILAPLE  IN  HhTCHR  --  I KRKS/»  • , 1 5 ) 
FNO 


RHTKlOftOO 
0HT6O8] ‘ 
0HTOOS 
HHT008, 
BHTO0S4O 
BHTO0850 
BHT 00860 
HHTOOefO 
HHT006SO 
PHT00890 
HHT00900 

HHT0093Q 
BHT00940 
BHT00950 
SHTOOOftQ 
HHT 00970 
HHT00950 
*JMT  00990 
BHTOIOflO 
(3HT0I010 
8HT01020 
8HT0]  ‘ ‘ 
BHTO 
BMTO 
BHTO 
PMToi 
BHT01080 
BHT01090 
BHTOllOO 
HMTOjilO 
HHT01I20 
BHT01130 
HHT01I40 
BHTO1150 
BHTOjiftO 
8HT0il70 
RHTOlieO 
pmtoiIqo 
8HTOi2O0 
HHT01210 


HHTOli 

RMTOi; 


20 

30 


HMT01240 

HHT01250 

BHT012ft0 

«hT0!270 

PHT01280 

HMT01290 

bHTOiaOO 


BHTO 

BHTO 


\l 


-10 

320 


HHT01330 
RHT01340 
HHT01350 
bHT0l3ft0 
BHTOUTO 
hHT013ftO 
BHTO) 390 
HHTOiAOO 
HHT01410 
HHTP1420 
HHTO 1430 
HHT01440 
RHT01450 
RhTO  I4*i0 
BHT01470 
PHT014A0 
BHT01490 
HHTOISOO 
HHTOISIO 


riLFJ  BSTCHK 


SU*^R0UTIN£  <1STCHK(N08(.STI 
IMPLICIT  INTE6EP  «<k-H.0-2) 


Call • • 

CALL  BSTCMs (N08EST) 

AR6S.. 

NOBEST  - NO  OF  FEATUPES-TUPLES  TO  ANALTZC 

REOUIPFS. 

COMMON  /inform/ 

PURPOSE . . 

CHECKS  validity  of  requested  feature-tuples 

RETURNS.. 

CORRECT  FEATURE-TUPLE  QUE 

CALL.. 

CALL  ShmCmK (COMBUF.CPTR) 

AR6S.. 

COMBUF  - SMOK  request  OUE 

PURPOSE.. 

CHECKS  VALIDITY  OF  SHOW  REQUESTS 

returns.. 

CORRECT  SHOW  REQUEST  OUE 

C 

8 

f. 

8 


DI»'ENS10N  COMt?UF<n 
INCLUDE  COHBKl,LI«iT 


csend 


10 

?0 

10 


C 

r 

c 

r 

r 

c 


0 

30  T = 
J * BE^T 
IF« J.GT. 
TI  * II*j 
HESTVC ( 1 1 
GO  TO  10 
wpTTC 
P0OM4T ( • 

• FATUBP^. 
CONTI NUF 
NOBEST  « 

betupn 


1 ,NOBEST 

vcm 

NOFFTi»)GO 
) s J 


TO  10 


Aaotao  I imfsT • • • t II. * IS  G»E*TER  than  OP  EQUAL  TO  NO.  OF 
IM  GIVEN  OATA... ignored*) 

II 


1? 


11 


ENTRY  EvLCmk  (COMKIF.CPTR) 

no  3?  TsI.nOFET? 

INVENT ( I » =0 

no  11  IsI.nofft? 

« S FFTvC^'(I) 

invert (k) =I 

K » 0 


dimension  INVEPTOO) 

INCLUDE  COM^-^  r.LIST 

common/ I NFORM/NOCLS?. NOSUB?. N0FET?.VARSZ?.T0TVT?.N0KL02.^„,  , 

• AVAP?.COVAH?.CLSIO?.5UBNO?.SUBOS2.FlOSV?.VERTX?» 

• FETVC2I10) .SUHVC2(7S) .SUBPTP(7S> .CLSVC2(60) . 

• KEPPTSINO)  .NOGPP.6HPNAM<60I  .CjPPOEXiel)  . 

• GHPCHK (M ) .GROUPS ( 124) 
COMMON/FSL/rF»C.TOTMSP.SEPMSP.PRCKEY.CRlKEY.INCFET. 

• INCVEC(IO) .ICOUNT.StTwGT.EVALHF(lOO) .FFTVC4(30)^. 

• .NOFFT<..VAWS74.COPbAS.0TAR4.MtHSl*»BESTVC ( 10) .OjVSIZ 

• .STaT«Y. AORESO.AOPESR.AOHESF.AORSHI , A0PSM2 
INTEGER  AUHFSO. AORESP.AnPFSF.AnHSMl . AORSHZ.STATXY 
DOUBLE  PRECISION  CFAC.TUTmSR.SEPmSR 


NSTOOOlO 

BST00020 

MStOOOlO 

HStOOOAO 

BSfooOSO 

USTOOOBO 

BST00070 

Bstoooao 

HST00090 

BSTOOlOO 

HSTOOllO 

BSTQ0120 

BST00130 

BST00140 

HSTOQISO 

BST00160 

BSTC0170 

BST00180 

BST00190 

BST00200 

HST00210 

HST00220 

BST00230 

BST00240 

BST002S0 

HST00260 

§I?88I28 

B5T00290 
HST00300 
BST00310 
MST00320 
RST00330 
BST00340- 
BST003S0 
-RST003GO 
-MST00370 
BST003B0 
BST00390 
PST00400 
PST00410 
BST00420 
BST00430 
HST00440 
COHOOOlO 
COM00020 
COM00030 
COM00040 
COMOOOSO 
COH00060 
HST00520 
PST00S30 
PSTO0S4O 
HSTOOSSO 
HSTOOSNO 
HST00570 
BSTOOSBO 
HST005R0 
NSTOOOOO 
FBST00610 
BSTO0N20 
MST000.10 
HST00640 
HST006S0 
RSTOOeftO 
BST00670 
PST006B0 
— HSTOOOPO 
— MSTO07O0 
PST00710 
faST00720 
RST00730 
HST  00740 
RST007S0 
hST007ft0 
RST00770 
HST007RO 
BST00790 
HSI OOBOO 


10 


FILFt  BSTCHK 


I 3 1 

40  !F  (I.GF.CPTR)  60  TO  100 
N « COMHUFdJ 
J « I*N 
I * 

LAST  s 0 
00  50  L=I.J 
LL  = COMBUF(L) 

IF  (LL.LE.LA5T.0R.INVERT(LL) .EO.O 

If  , 

sn  LAST  r LL 
K = K*1 
COMHIiF(K)  = N 
no  AO  l.  = ItJ 
K = K»1 

AO  COMflUF(K)  s COMRUF(L) 

70  I = J*1 
GO  TO  40 

OO  WRTTF  (6,00) (COMBUF(LL) »LLaI»J) 
on  format (•  invalid  evaluate  request 

GO  TO  70 

100  CPTR  = K 

RETURN 

END 


psTooeio 

RSTOOflPO 

BST00830 

HST00840 

BSTOOeSO 

PST00860 

BST00870 

HST00880 

,0R.LL.GT.FETvC2(N0FET2) ) GO  TO  8bST008RO 

BST00900 
BST00910 
RST009P0 
yST 00930 
MST00940 
8ST00950 
HST009A0 
H5T00970 
RST00980 
BST00990 

esToiooo 

....•,1814)  PSTOIOIO 

hSTOlOPO 

BST01030 

HSTO104O 

BST01050 

B5T01060 

BST01070 


nooonooooooor>r>or>nor>nonor>ooor>o 


FILEl  COLINV 


SUBROUTINE  COLINV (S.N.lERR.INOtOET) 

DOUBLE  PRECISION  StSUR.OET 

PURPOSE 

INVERT  ft  GIVEN  SYMMETRIC  POSITIVE  DEFINITE  MATRIX  (S)  BY 
COMPUTING  ft  TRIANGULAR  FACTORIZATION  (R) , INVERTING  R TO 
obtain  ft.  AND  THEN  FINDING  THE  INVERSE  OF  S. 

S=R*( transpose  of  R),  AsHNVERSE  OF  R)  . 

(INVERSE  OF  S)=(THANSP0SE  OF  A)*A  . 

ARGUn>ENTS 

s -lower  triangular  Part  of  the  given  symmetric  matrix 

STOfifn  ROrtWlSE  in  N*(N*1)/2  SUCCESSIVE  STORAGE  LOCATIONS, 
on  RETURN  S CONTAINS  THE  LOWER  TRIANGULAR  MATRIX  Ri 
THE  lower  TRIANGULAR  MATRIX  At  OR  THE  LOWER  TRIANGULAR 
PART  OF  THE  INVERSE  OF  S»  DEPENDING  ON  VALUE 
assigned  to  IND. 

-THE  NUMOEft  OF  ROWS  OR  COLUMNS  IN  GIVEN  MATRIX. 

-RESULTING  ERROR  PARAMETER  CODED  AS  FOLLOWS 
IERR=0  -NO  ERROR 

IERR=-1  -matrix  S is  not  POSITIVE  DEFINITE 

-parameter  indicating  which  matrix  is  returned  — 

INO=l  -matrix  R 

1N0=?  -MATRIX  A 

lNf)=,^  -MATRIX  (INVERSE  OF  S) 

-determinant  of  returned  matrix. 


N 

IFRR 


I NO 


DET 


REFERENCE 

•INVERSION  OF  symmetric  POSITIVE  DEFINITE  MATRICESt*  BY 

J.K.  RRYAN  AND  O.L.  TEBBEt  E.E.  DEPT.,  UNIV.  OF  MISSOURIt  1971. 

DIMENSION  S(l) 
lERR  = 0 
LS  = 0 
N2  = 1 
OFT  = 1.0 
no  70  1=1, N 

N?  = N2  ♦ I - 1 

M = I*(I*l)/2 

L = N? 

no  AO  J=I,N 

L = L ♦ J - 1 

IF(  I .EO.  1 ) GO  TO  20 

Ml  = J*(J-l)/2  ♦ 1 

1-1  = L - 1 

N1  = N? 

no  in  K=M1,L1 
S(L)  = S(L)  - S(N1)*S(K) 
in  N1  = N1  ♦ 1 
?0  IF(  J .EO,  I ) GO  TO  30 
S(L)  = S(L)/S(M) 

GO  TO  An 

30  IF(  S(L)  .LE.  0.0  ) GO  TO  100 
S(U  = nSORT(S(U  ) 
nET  = nET*S(L) 

AO  CONTINUE 

TE(  INO.EO.I  ) GO  TC  70 
S(M)  = l./S(M) 

TE(  I .FO.  I ) GO  TO  70 

T1  = I - 1 

00  60  J=1.I1 

Kl  = I - J 

LI  = LS 

IS  = LS  ♦ 1 

Ml  = J»(J-l)/2  ♦ 1 

J1  = J - 1 

SUM  = 0.0 

nn  so  K=i,Ki 

LI  = LI  ♦ 1 

J1  = J1  ♦ 1 

Ml  = Ml  ♦ J1  - 1 
SO  SUP  = SUfl  ♦ S(L1)*S(M1) 

60  S(LS)  = -S(M)*SUH 

70  LS  = LS  ♦ 1 

IF(  INn.fc-rj.?  .OR.  IN0.EO.3  » OET  = l./OET 


TF(  INn.EN.l  .OR. 

no  90  r=i,N 

M = T«(I-l)/2  ♦ 1 

L = M 


IND. EG. 2 ) RETURN 


COLOOOlO 

COL00020 

COL00030 

COLOOOAO 

COL00050 

COL00060 

COL00070 

COLOOOAO 

COL00090 

CULOOlOO 

COLOOllO 

COLOOIZO 

COL00130 

COLOOIAO 

COLOOISO 

COLOOIAO 

COL00170 

COLOOIBO 

COL00190 

COL00200 

COL00210 

COL00220 

COL00230 

COL002A0 

CQL00250 

COL002G0 

COL00270 

COL002R0 

COL00290 

COL00300 

COL00310 

COL00320 

COL00330 

COL003A0 

COL00350 

COL00360 

COL00370 

COL003BO 

COL00390 

COLOOAOO 

COLOOAIO 

COLOOA20 

COL00A30 

COLOOAAO 

COL00A50 

COL00A60 

COL00A70 

COLOOAGO 

COL00A90 

COLO050O 

COL00510 

COL00S20 

COL00530 

COL005A0 

COL00550 

COL00560 

COtOOSTO 

coLOosao 

COL00S90 
CUL00600 
COL006) 0 
COL00620 
COL00630 
COL006A0 
COL0O6S0 
CUL00660 
COL00670 
COL006«0 
CUL00690 
COL00700 
COL00710 
COL00720 
COLn0730 
COL007A0 
CUL007S0 
COL00760 
CUL00770 
COL00780 
COL00790 


1P^2 


FILE:  COLINV 


no  90  Jal.N 
L2  » L 

L = L ♦ J - I 
SUR  s 0.0 
00  flO  K=J»N 
L2  = L?  ♦ K 
Ml  = L2  ♦ J 
no  SUB  3 5U0  ♦ 

90  S(l.)  s SUH 
PET  = OET*OET 
RETURM 

100  IER«  = -I 
RFTURN 
ENP 


: \ 

S(L2)*S(M1) 


COL00800 
COL«0810 
COL00820 
COL00830 
COL00840 
COL 00850 
COL00860 
COL00870 
COL00880 
COL00R90 
COL00900 
COL009I0 
COL00920 
COL00930 


c ^ 


rtn  no  o o noon 


FILFI  CONVRT 


SURROUTINF  CONVRT (NOSPAC.IFLG) 


THE  PURPOSE  OF  THIS  ROUTINE  IS  TO  CONVERT  ERCOIC  CHARS 
OR  TO  CONVERT  COMPUTATIONAL  CHARS  TO  EBCDIC  CHARS 


LOGICAL*!  LTEST(A) ,LSPAC(4) 

FOtllVilENCE  (ITEST*LTEST(4) ) » ( ICHAR»LSPAC (4») 

DATA  8COO/2FO/»BCD9/ZF9/ 

ITFST  a 0 
ICHAR  s NOSPAC 
I.TFST(4)  a ISPAC(4J 

CK  FOP  FL»f>  NOT  0*  IMPLYING  CHAR  IS  EBCDIC 
IF  (IFLG  ,NF.  0)  GO  TO  lOfiO 

CK  FOR  rOMpUTAT TONAL  NUhhER  K CONVERT  TO  ERCOIC 

IF  (ITFST  .LT.  0 ,0P.  ITEST  ,6T.  9)  GO  TO  9999 

ITFST  a ITEST  * bCOO 
LSP4C(4)  a LTFST(4) 

NOSPAC  a ICH4R 

return 

8 CK  FOP  ERCOIC  NU4HFR  TO  CONVERT  TO  COMPUTATIONAL  NUMBER 
1060  IF  (ITFST  .IT.  HCDO  .OR,  ITEST  .6T.  BCD9)  60  TO  9999 
ITFST  a ITEST  -BCOO 
LSPAC(4)  a LTFST(4) 

NOSPAC  a ICHAH 
RETURN 
C FPROR 

99<j<5  WRITE  (6.R994) 

999P  format  (1K.*ERR0R  - NON-NUMERIC  CHARACTER  INPUT*) 
RFTURN 
FNO 


CONOOOlO 

coNoooao 

COMPUTATIONCON00030 

CON00040 

CONOOOSO 

CONOOOAO 

CON00070 

CON00060 

CON00090 

CONOOlOO 

coNOoilo 

CON00120 

CON00130 

CON00140 

CONOOiSO 

CONOOIAO 

CON00170 

CONOOIBO 

CON00190 

coNOoaon 

CONOOPIO 

CON00220 

CON00230 


CON00240 

CONOOgSO 

CON00260 

CON00270 

CON00280 

CON00290 

CON00300 

CON00310 

CON00320 

CON00330 

CON00340 

CON00350 


FILE 


CUBIC 


,ARRAY(4*4) 

.F 


»C0EFF(4J 

*XMIN2 


14 

15 


?0 

7 

?1 


10 

6 


11 


12 


??. 


?3 

?A 


17 

?5 


16 


SUBROUTINE  CUBIC (XX»YYfXMIN2) 
nOURLE  PRECISION 
1XX(4)  *YY(4) 

PTFMP  ,A0D 

no  14  I s 1,4 
ARR4Y(I,1)  * 1.000 
ARRAY(T,?)  = XXm 
ARRAY(I,3)  = XX(I)**2 
ARRAY(I,4)  = XXU)**3 
CONST(T)  = YY(I) 
no  6 K?  = 1.3 
KK  = K2  ♦ 1 
L s K? 

no  7 I = KK,4 

lF(DABS(AkWftY(I,K2)  ) - 0ABS(ARRAY(L»K2) 1)7,7,20 

CONTINUE 

L = I 

CONTINUE 

IF(L  - K2)8.ti,21 

CONTINUE 

no  9 J = K2.4 

TF“P  = ARkAY(K2,J) 

ARRAY{K?.J)  = ARRAY<L,J) 

ARPAY(L.J)  = TEMP 
TFNP  = CONST (K?) 

CONST (K?)  s CONST «L) 

CONST (L)  = TFMP 
no  6 I = KK.A 

F = ARPAY(1,K2)/ARRAY(K2,K2) 

array(I,k2)  = n.ono 

no  10  J = KK,4 

ARRAYd.J)  = AWBAY<I,J)  - F*ARRAY  (K2,  J) 

CONST (I)  = CONST (I)  - F*C0NST(K2) 

C0FFF(4)  r C0NST(4>/ARRAY<4,4) 

11*=  I ♦ 1 

Ann  = o.ono 
no  1?  J = 11,4 

ADO  = ADD  ♦ APRAY{I,J)*C0EFF!J) 

COFFF(T)  = (CONST(I)  - A0n)/ARRAY(1,I) 

1 = 1-1 

IF(T)2?,22.ll 

CONTINUE 

F = rOFFF(3)«*2  - 3.0DO*COEFF(2)*COEFF(4) 

TF(F) 18,23,?3 
CONTINUE 

TF(DAP':(C0EEF(4n  - I.OD-IS)  17,17,24 
CONTINUF 

xmTN?  = <-COEFF(3)  ♦ DSORTIF) )/(3.0D0*COEFF(4) ) 
PFTiJPN 

IF(nAp.‘;tCOtFF  (3)  ) - I.OO-IS)  16,16,25 
CONTINUE 


, CONST (4) 


YMTM?  = 
RFTUh'vI 
XMTN?  = 

return 

END 


COtf F(?)/(COEFF<3) 

o.ono 


♦ OSOPT(F)) 


CUB0OO1O 

CUB00020 

CUB00030 

CUR00040 

CUR00050 

CUB00060 

CUB00070 

CUR00080 

CU600090 

CUBOOlOO 

CUBOOllO 

CUB00120 

CUB00130 

CUB00140 

CUR00150 

cueooi60 

CUB00170 

CUR00180 

CU800190 

CUR00200 

CUB00210 

CUB00220 

CUR00230 

CUB00240 

CUB00250 

CUB00260 

CU0OO27O 

CUB002R0 

CU0OO29O 

CUB00300 

CUB00310 

CU800320 

CUR00330 

CUB00340 

CUB003SO 

CU0OO36O 

CUB00370 

CU800380 

CUB00390 

CUR00400 

CUP00410 

CUB00420 

CUB00430 

CU600440 

CUR00450 

CUH00460 

CUP00470 

CUB004RO 

CUB00490 

CUB00500 

CU800510 

CUR00520 

CUn00530 

CUr300540 

CUR005SO 

CUb00560 

CUB00570 


FILF 


OAVONl 


C» 

C» 

C* 

C« 

C* 

c* 

c* 

c» 

8: 

c* 

c* 

c» 

c* 

€• 

C 


CHENn 


c* 

c* 

c* 


?n 

?l 

:^o 

*0 

ion 


SUflROUTINE  OAVONUFX.P»H) 

OAVON]  initializes  THE  H AND  P ARRAYS  USED  IN  OAVIOON. PROCEDURE 

HaTRIX  is  an  N*N  matrix  approximating  the  INVERSE 
matrix  of  partial  derivatives,  it  is  initialized 
here  as  The  IOENTITV  matrix  and  stored  on  scratch 
FILE,  The  h matrix  is  updated  after  each  cycle  thru 

THE  SEARCH  PROCEDURE  OF  SUBROUTINE  OAVON2. 

p*«*««  VECTOR  f.ORRFSPONOiNG  TO  SEARCH  DIRECTION 
(H-MATRIX  times  the  GRADIENT) 

DFDK**  minus  the  norm  of  the  gradient  with  respect  to  the 
H-maTRIX  souarfo. 

FX****  6HA0IFNT  OF  FUNCTION  TO  BE  MINIMIZED 
• H • AND  • FX«  SAVED  ON  SCRATCH  FILE  TO  BE  USED  IN  DAV0N3 
INCLUDF  COM'-i-'T.LIST 

COMMUN/FSL/rFAC,TOTMSR,SERMSR,PRCKEY,CRIKEYtINCFET» 

• iNCVECtlO)  . ICOUNT.SETWGT.EVALBF  <100)  tFETVCAOO) 

• .NOFET4,VA»SZ4»CORBA5«DTaB*.W6HS14,RESTVC(10) «0IVSIZ 

• .STATXY. AORESO.ADRESP.AORESFtAORSHl .A0RSH2 
INTEGER  AORESn. AOPESP.AOHFSF, ADRSHlt A0RSH2.STATKY 
nOUSLE  precision  CFACfTOTMSR.SEPMSR 

DOUpLE  precision  FX  (1) ,P(1) ,h(1) ,ofok 
nO'iRLF  PRECISION  CAYMIN»FIItCCAY 
INTEGER  AD 

COMMON/OVNBLK/OFOK,CAYMIN,FIlfCCAVt I10.11DMEN,ITT,ICNT,N 

N2=N*2 

OFDKsO.O 

ad=aorshi 
no  30  1=1, N 

P(T)=-FX(I) 

nFnK=DFDK*P(I)*FX(I) 

DO  20  J=1,N 
H(  J) =0.0 

IF (I ,F0. J) H( J) =1 .0  , 

CALL  RwRITE(A0.H,N2f ISTAT) 

A0=Ar)  + H2 

IFdSTftT.FQ.DGO  TO  21 
IF(ISTAT.EQ.0)6O  TO  30 
WRTTf  (F, loO) ISTAT 
CONTINUE 

SAVE  FX  ON  SCRATCH  FILE 

CALL  PRRITE(ADPFSF,FX,N2*ISTAT) 

IFdSTAT.-lU.l  )G0  TO  40 
IFdSTAT.FD.OjRETuHN 
WRTTF (G, 100) ISTAT 
CALL  CMFRR 

FORMAT </•  ERROR  ON  DRUM  FILE  - SUBROUTINE  DAVDNl ISTAT=»,I3) 

END 


OAVOOOlO 

DAV00020 

DAV00030 

OAV00040 

DAVOOOSO 

DAV00060 

DAV00070 

OAVOOOBO 

OAV00090 

DAVOOlOO 

OAVOOilO 

DAVO0I2O 


OAVOOI3O 

DAV00140 

DAVOOISO 

0AV00160 

OAV00170 

DAV00180 

OAVOOIRO 

COMOOOlO 

COM00020 

COM00030 

COH00040 

COM00050 

COMOOOGO 

DAV00210 

OAV00220 

OAV00230 

DAV00240 

DAV00250 

OAV00260 

DAV00270 

DAV002P0 

DAV00290 

DAV00300 

DAV00310 

OAV00320 

DAV00330 

DAV00340 

DAV003S0 

DAV003H0 

DAV00370 

DAV003R0 

DAV003R0 

UAV00400 

DAV00410 

OAV00420 

OAV00430 

DAV00440 

DAV00450 

DAV00460 

DAV00470 

UAV004R0 

OAVO0490 

OAV00500 


FILE:  DAVDN? 


C 

C 

C 

C* 

C* 

C* 

C 

C 

C 

C 

C 

C 

C 

c 

c 


c 

c 

c 

c 

ccc 

ccc 

rcc 

ccc 

ccc 

c 


SURROUTINF.  0AV0N2(XeAR«XRARS*P*WRK«IWKSZt*) 
nmiRlF  PRECTStON  XPAR(N)  IXRARS(N)  «P(N)  vtaPKdWKSZ) 
nOlJHLE  PRECISION  FMAT(4»,CXV(A)»X(10)tY(10)» 

• CAyMIN,CCAY,OFOK,EPSCF,£PSGStEX.F,FII* 

• 61 .6?.TtMP.XMlNl,XMlN2,XNFW 
COMMON/nVNHLK/nFOK.CAYMlN.FII .CCAYfI10*IlDMEN,ITT.lCNTtN 

. DFDK*****  minus  the  norm  of  the  gradient  WITH  RESPECT 

THF  H-maTRIX  SOUARFO 

FIT******  INITIAL  VALUE  OF  FUNCTION  TO  BE  MINIMIZED 
ipart****  sft  to  -1  SO  partials  will  not  be  COMPOTEO 

O'luiNG  SEARCH 

N***«***«  ni|Mhfr  of  variables 

ITT******  COU^TE^^  DENOTING  THE  NUMBER  OF  EVALUATIONS 
OF  THE  FUNCTION  TO  PE  MINIMIZED 
vfcTOh  COWRESPONOING  to  SEARCH  DIRECTION 
(S-t-ATRIX  tT-'ES  the  GRADIENT  ) 

XBAR*****  NOMINAL  vector  of  CONTROL  PARAMETERS  AT 
THF  START  OF  EACH  CYCLE: 

XRARS****  PFRTURHFO  VECTOR  OF  CONTROL  PARAMETERS  IN 

accordance  with  the  oavidon  algorithm  and 

SEARCH  PROCEDURES 
Gl  = l.SDO  - DSORT(1.2SUO) 

G2  = i.oon  - Gl 

THIS  STARTS  ONE  DIMF.NSIONAL  SEARCH  ON  K 


INITIAI.IZF  id  SEARCH  VARIABLES 
FRSCF  IS  RELATIVE  FPSILON  FOR  CUBIC  FIT. 

FPS6S  IS  RELATIVE  EPSILON  FOR  OOLOEN  SECTION, 

KURIC  = 1 CUNlC  FIT  METHOD 
KUBTC  = n GOLDEN  SFCTION  METHOD 

KUBIC  = -1  GOLDEN  section  AND  CUBIC  FIT  METHODS  COMBINED 


90DP  IPART=-1 

Y(10)  s FII 
JSW  = -1 
KU«>IC  = 1 
FPSCF=1.0-T 
CAY  . 1 ) =0.U*n 
FHAT(l)  = FII 
CAY (2) =CCAY 
00  RORO  1=1. N 

9009  XBAPS(I)=XHAR(T) ♦CAY(?)*P<1) 

CALL  FI'jT?(FhaT  (2)  . IPAHT.XHARS«WRK»  IWKSZ*L9999) 

Y(0)  = FHAT(2) 

X(0)=CAY(?) 

ITT=ITT*1 

Y ( 1 ) =?.n+()«  (FHftT  (2)-FHAT  ( l)-0F0K*CAY(2)  )/  (CAY  (2)  *CAY(2)  ) 
IFIYd)  - l.nO-15)ROAO,lfl 
1 CONTINUE 

XMTN1=-0F0K/Y ( I > 

CAY(3) =XMIN1 
904?  no  004)  1=1 .N 

9041  XBAPS(I)=XPAR(!)*CAY(3)*P(I) 

CALL  FI\T?(FhaT (3) . IPART.XPARS.WRK, IWKSZ.L9999) 

1TT  = ITTM 
GO  TO  9043 

9040  CAY (3) =CCAY*1 .20*0 


XMINI =Cf Y ( 1) 
r-0  TO 


904  3 Y ( 1 ) =FHiT  (2)  -FhAT  : : ) -nFfiK*CAY  (2) 
V (?) =FHAT ( 3) -FhaT  n ) -nFUS*CAY (3) 
X (1  ) =CAY  < ?)  »CAY  (2)  /P.O*)) 

X (?)  =X  (1  ) ‘-CAY  (?)  /3. 0*0 

xn)=rAY(3)^CAY(3)/?.o*o 
X(4)=X(X)<>CAY(3)  /3.0*0 
Y(3)=X(3)*X(?)-X())«X(4) 

Y (N) =Y ( 3) 

1F<Y(3).,T.o.D*0)V(G) =-Y (3) 

XNFw  = Y(1) 

Y(4)  = (X(?)'*Y(?)-x(4)*Y()))/Y(3) 
Y(‘^)  = (X(3)*Y(n-X<l)*Y(2))/Y(3) 
V(X.)=Y(A)«Y(4)-?.0*0*nFUA*Y(5) 


TF ( Y (G) ) 9044, ?. 2 
? rOMlNUF 

xMiN?  = -?.ono*nFnK/(Y(4)  ♦ osort(y(6))) 

1F(X-1N?  - 1 . 0I)-1S)  9044, 3, 3 
3 rONTINlIF 

IF  (OaHC  ( X>^IN2-XMIN1  ) - ERSr.f  *XMIM  ) 4,4,904S 


TO 


OAVOOOlO 

OAV00020 

OAV00030 

OAV00040 

DAV00050 

DAV00Q60 

OAV00070 

DAVOOOBO 


OAV00090 

OAVOOIOO 

UAVOOllO 

OAVO0I2O 

OAV00130 

DAVQOUO 

OAV0015Q 

OAVOOIGO 

OAV00170 

DAV00180 

OAV00190 

OAV00200 

DAV00210 

DAV00220 

OAV00230 

DAV00240 

OAV002SO 

DAV00260 

DAV00270 

OAV002R0 

DAV002O0 

UAV00300 

OAV003IO 

OAV00320 

OAV00330 

OAV00340 

OAV00350 

UAV003N0 

DAV00370 

OAV003P0 

OAV00390 

OAV00400 

OAV00410 

DAV00420 

DAV00430 

OAV00440 

OAV004S0 

DAV00460 

OAV00470 

OAV004P0 

OAV00490 

OAVOOSOO 

OAV00510 

DAV00520 

UAV00530 

OAV00540 

OAVOOSSO 

OAV00560 

OAVOOS70 

OAvnospo 

OAVOOS90 
OAV00600 
OAV00610 
DAV00620 
OAV00630 
OAV00640 
OAV006S0 
OAV006G0 
DAVOOt  70 
DAVOOfeHO 
OAV00690 
OAV00700 
OAV00710 
OAVO07P0 
DAVO0730 
PAV00740 
r)Avoo7so 
{)AV007HO 
UAV00770 
UAVO07HO 
DAV00790 


oooo 


FILE 


DAV0N2 


4 rONTlNUF 
CAYHINaXHIN? 
no  TO  9099 
9045  C4Y(4)»XM1N? 
no  TO  9044 

CAY(4)«CAYn)*1.50»0 
no  9047  1 = 1. N' 


9044 

904A 

9047 


9050 

9056 

001 

6 

609 


3«;0 

3?0 

330 

340 


» 1»1 
= 1.3 

- CAY(I.l) )90S0.5.5 


XBA9S(n«XB4Rll>.CAY{4)»P(l) 

SitL.El''^^2(PHAT(4)  f IPART.xftARS»WRK»IWKSZf49999) 
1TT*1TT.1 
no  9050  J 
00  90S0  I 
IF(CAV(I) 

CONTINUF 
TEMP  a C4Y(I) 

CAY(I)  = CAY(l.l) 

CAY(I.l)  = TFMP 
TEMP  ■ FHATd) 

FHATd)  s FhaT(I.I) 

FHAT<1.1)  = TEMP 
rONTINUe 
fiO  TO  S4? 

FIT  * Y(in» 

C4Y<A>=X{9) 

FH4T<4) =Y<9) 

TinwEN  = -1 
j^APTa-1 

KI.IRK  = 1 
IFdl0)fl88.968.6 
CONTINUE 
KIJPIC  = 0 
XMINl  = 0.000 
C4Y(l)sO.D.O 
FHATd)  = Eli 

IF(nFOK  ,6T.  -1.0-12)60  TO  340 

IFCOFOK  ,6T.  -1,0-9)  60  TO  330 

IFIPFOK  ,GT.  -i.0-5)  60  TO  320 


TF(0F0k,6T,-1. 0*1)60  TO  350 
EP5GS=1 .0-2 
FP9CF=l.n-2 
60  TO  410 
FPSCF=1.0-3 
EP5G5=1 .0-3 
60  TO  4lfi 
FP^CFsl .fi-S 
EPS65=1 .0-5 
GO  TO  410 
EPSCF  = 1.0-2 
FPS6S  = 1.0-2 
60  TO  4lO 
EP5CF  =1.0-1 
EPSGS  = 1.0-1 


oftPT  1 

ESTAPLISH  golden  section  in  which  function  is  UNIMOOAL 

410  IF d 10) 7.7.9067 
7 rONTIMUF 
CAY (4) =CC4Y 
420  no  4 30  1 = 1 

430  X64WSd)=AMin(I)*CAY(4)*P(T) 

CALL  FlnT2{6HAT(4) . IPART . XPARS. WHK, I WKSZ .69999) 

ITT  = ITT  ♦ 1 
9067  rONTINlIF 

TF(FMaT(4)  - EHAT { 1) ) n.490.490 
P rONTlNUE 
440  CAY(?) =CAY (4) 

FHAT (?) =FhAT (4) 

CAY(4)  = CAY(2)/61 
no  450  r=l.N 

460  XBARSd)=XrtftP(l)*CAY(4)4P(I) 

CALL  F1NT?(FHAT(4) . I P ART . XRAHS i WRK . I WKSZ . 69999) 

ITT  = ITT  ♦ ) 

IF(FHAT(4)  - FHAT (2) ) 440.9.9 

9 continue 

460  CAY(3)  = 62*(CAY(4)  - CAY(D)  ♦ CAY  (1 ) 

00  470  1 = 1 .N 

470  XBAW5(t)=XHAK( f ).rAY(3)*P(I) 

CALL  EIWT? (PHAT ( J)  . I PART . XH AWS . WHK . I WKSZ . 49Q99) 


8 


DAVOOeOO 

OAvooeio 

0AV00820 

DAV00830 

OAV00840 

DAV00850 

DAV00860 

QAV00870 

OAV008P0 

04V00890 

OAV00900 

OAV00910 

DAvn0920 

nAV00930 

OAV00940 

OAV00950 

OAV00960 

DAV00970 

nAV00980 

OAV00990 

OAVOIOOO 

OAVOlOlO 


DAVO 

DAVO 


DAV0104 


0 

DAVOIOSO 
OAV01060 
OAV01070 
DAVOiOBO 
OAV01090 
DAVflllOO 
DAVOniO 
DAV01120 
DAVOl 130 
OAV01140 


OAVO 

DAVO 


ii 


50 

60 


DAV01170 

OAVOllBO 

DAV0l|90 

DAVOiZOO 

OAV01210 

OAV01220 

DAV01230 

DAV01240 

OAV012S0 

OAV01260 

l)AVOi270 

OAV012PO 

DAV01290 

OAV01300 

OAV01310 

DAV01320 

OAV01330 

OAV01340 

OAvoiaso 

OAV01360 

nAV01370 

OAV013«0 

UAV01390 

rAvni400 

DAV01410 

OAV01420 

DAV01430 

DAV01440 

OAV01450 

DAV01460 

UAV01470 

DAV014P0 

DAV01490 

DAV01500 

DAV01510 

OAV01520 

DAV01530 

OAV01540 

DAV01550 

OAV01560 

DAV01570 

DAV015H0 


FILE 


0AV0N2 


C 

C 


ITT  « ITT  * 1 

IF(FH4T(A)  - FHATO) ) I0»l0t5l0 
CONTINUE 
FHATU)»FHAT(3) 

CAY(*>«CAY(3) 

CAYO)  «CAY<?) 

FHAT(3)«FHAT(2) 

CAY(2)«CAY(4)  - CAYO)  ♦ CAYd) 

no  4A0  1*1, N 

XHARS(T)*XBARn)4CAY(2)*Pm 

CALL  FINT2«EhAT<2)  ♦IPA«T,XRARS,WRK,IWKSZ,L99'»9) 

ITT  ■ ITT  ♦ 1 

IF(FHAT(2)  - FHAT(l) )510,ll,ll 
CONTINUE 

FHAT(4)  a FHAT(2) 

CAY(4)  a CAY(2) 

IF<  inAVN.E*.'.?)  GO  TO  ROOT 
CAY(2)  a «1*(C4Y(4)  - CAY(l))  ♦ CAY(l) 

IF(CAY(2)  - 1.00-15)12,12,495 
rONTlNUF 
CAVMTNaO.O*0 
WRITF(  6 ,492) 

FORMaT(1x,4^.HMINIMUM  is  AT  ORIGIN  - PROGRAM  CANNOT  CONTINUE) 
RETUP'J  1 

00  son  Ial,»j 

X8ARS(l)aX4AR(I)»CAY(2)*P(I) 

CALL  FINT2(FHAT (2) ♦ IPART.XBAPS.WHK, IWKSZ,i9999) 

ITT  a ITT  ♦ 1 
1F(FHAT(2)  ,LT.  FHAT(1))G0  TO  460 
GO  TO  485 

PART  7 

SHRINK  THE  GOLDEN  SECTION  CONTAINING  THE  MINIMUM 


10 

475 


4A0 


11 

4«5 

40A 


1? 

ROOT 

492 

40S 

500 


510  IF  (IlOMFN)  n,  1.1,9066 
n CONTINUE 

514  IF(FHAT(3)  - FH A T ( ? ) ) 1 4 , 625, 520 
14  CONTINUE 

CAY(1 )aCAY(?) 

Fh4T(1)=FhaT(2) 

CAY(?) aCAV (1) 

FhAT(2)=FhaT(3) 

CAY (3) =CAY< 1) *CAY (4) -CAY(?) 

FX  = CAYO) 

J5W  a 1 
GO  TO  612 

570  CAY(4)  a C4Y(3) 

CAY(4)aCAY( 3) 

FHAT(4)aFH4T(3) 

CAY (3) aCAY (?) 

FHAT(3)aFHAT(?) 

CAV(?)aCAYin*CAY(4)-CAY(3) 

FX  = CAY(?) 

JSW  a -1 
GO  TO  ^12 

5?5  FhaT(I)  a F^^AT(2) 

FHAT( I ) rFHAT (?) 

CAV  (A  ) aCAY  n) 

THAT (4) aFMAT (G) 

CAY(l)  a 3.(>U*0«CAY  (2)  - CAY(3)  - CAY(I) 
CAY() )rC4Y(?) 

CAY(?)  a CAY(4)  ♦ CAYd)  - CAY(3) 

FX  a CAY(?) 

J5«l  a 0 
GO  TO  M2 
57A  FHAT(l)aF 


C 

C 

C 

r 


CHEC*<  ON  TnE  UNIMoOaLITY  OF  THE  FUNCTION  IN  THE  NFW  INTERVAL 

53n  IF(FHAT(2)  - FhAT  d)  ) 15, 1S,4«5 
le,  rONTINU*- 

IF(FHaT(3)  - FhaT (4) ) 16, 16,475 

16  continue 

PAwT  1 

FlNO  MINIHUi-  hy  EITHEi-  r.OLOFN  SECTION  OP  CUbIC  FIT  TECHNIQUE 

549  IF(CAy(1)  - CAY  (2)  * ( 1 . 0i)0*FPSGS)  ) 5H5,  1 7,  1 7 

17  CONTINUE 


OAV01590 
OAVOIGOO 
OAVOUlO 
DAV01620 
DAV01630 
OAV01640 
OAVOlbSO 
UAV01660 
DAV01670 
0AV01680 
DAV01690 
DAV0i70O 
OAV01710 
DAV01720 
DAV01730 
OAV01740 
OAV01750 
OAV01760 
OAV0l770 
OAV01780 
OAV01790 
OAV01800 
OAV01810 
DAV01820 
UAV01830 
OAV01840 
OAVOieSQ 
DAV01860 
OAV01870 
OAV01880 
OAV01890 
DAV019P0 
DAV01910 
DAV01920 
0AV01930 
UAV01940 
OAV01950 
OAV01960 
OAV01970 
OAV01980 
UAV01990 
OAV02000 
OAV02010 
DAV02020 
OAV02030 
UAV02040 
DAV02050 
DAV02060 
OAvn?070 
OAV02080 
OAV0209C 
DAV02100 
UAV02110 
DAV02120 
0Avn2130 
OAV02140 
OAV02150 
OAV02160 
OAV021 70 
OAVOplHO 
OAV0219U 
D4V02200 
0AV02210 
OAV02220 
UAV02230 
nAvn??40 
U6V02250 
UAVU2260 
JAV02270 
Uayo??mo 
UAV022P0 
r)AV0?300 
OAYn?310 
UAV0?3?0 
OAV02330 
UAV02340 
l‘'AV02350 
OAV02360 
OAV02370 


FILFI  0AV0N2 


S42 

1« 

10 

?0 

?A5 

5*10 

5B5 

C 

61? 

6n 

?1 

?2 

C 

C 

c 

2000 

?o?n 

?3 


?040 

3000 

3001 


3O0S 

3010 

30?0 

30>5 


.lO-^O 

306S 

30^0 

?4 


4000 

?6 


QQOq 


r 


IFlKUmC.EU.O)  GO  TO  5U 
TF(CAYU)  - I.on-5»5l0t542.542 
caul  CURIC(CAYfFHATtXMlM2) 
IF(Xm1n?)510,510»18 
CONTINUF 

IF(KU«IC.6T.O)  GO  TO  2000 

IF(XMINl)5»0,580tl9 

CONTINUE 

lF(XMIN2*n.nD0-EPSCF)  - XMINU20. 20*580 
CONTINUE 

CAYMIN  » (XMIN2  ♦ XMIN11/2.0D40 
00  TO  9999 
XMINl  X XMIM2 
on  TO  510 

CAYMlNx(CAY(3)*CAY(2) )/2.0»0 
GO  TO  9999 


DO  613  Ixl.N 

XRARS(T)  = xh4R(1)  ♦ EX*H(I) 

CALL  FINT2(F.1PAWT*XHARS*WRK. lWKSZ*fc9999) 

ITT  = ITT  ♦ 1 
IF(JSW)?1, 21,536 
roNTINilF 
FHAT (?)  X F 
IF(J55)540,?2,22 
CONT INOf 
FX  X CAY (3) 

J5W  X 1 
GO  TO  512 

RFARRANGE  Y(1)  50  THEY  ARE  IN  ASCENDING  ORDER 


no  2020  I X 1,4 
X(I)  X CAY(I) 

Y(T)  X FHAT(l) 

no  2040  J X 1.3 

no  2040  I X J,3 

TF(Y(I)  - Yli*l))2040, 23*23 

CONTINUF 

TE^^H  X Y(l) 

Y(T)  X Ytl*l) 

Y(l*l)  X Tt''R 
TF“R  X X(I) 

X(I)  X X(I*1) 

X(T*1)  X TF«M 
CONTINUE 
no  3001  Ixl.N 

XRARSd)  X XtlARd)  ♦ XMIN?  • P(I) 

CA!  L FT'iT?  !F  , Ii'AUT.xaARS,WWK,  IWKSZ, 4 9999) 

ITT  X ITT  ♦ 1 
no  3010  K X 1,4 

J X K 

IF (F.LT.Y (<) )GO  TO  3020 
CONTINUF 
on  TO  4000 
I X 4 

IFd  ,FO.  ))GC  TO  3030 
Yd)  X Y d-\ ) 

Xd)  X Ad-1) 

I X I-l 
GO  TO  3025 
Y ( I)  X h 
X(J)  X X'.JN2 
CALL  CH-:'IC(<.Y.xmiaj2) 

IF (XM1N2) 24,4000,24 
CONTINUF 

IF  (flAHC  ( X .'1N2-X  (1 ) ) - Er>SCF*XMlN2)  25.25,3000 
CONTINUF 
CAY^'IN  X X-'IN2 
GO  TO  9999 
IF  ( nnMf-'N) 

CONTINUF 
MJ91C  X -1 

xnini  = D.nn+o 
x«iM2  X n.nn.o 
GO  ro  51<. 

rCAYxCAY  •'In 
T lOMFNxI  10 


OAV023R0 

BAV02390 
AV02400 
OAV024iO 

BAV02420 
AV02430 
DAV02440 
OAV024S0 
OAV02460 
0AV02470 
DAV024G0 
DAV02490 
DAV02500 
OAV02510 
0AV02S20 
DAV02S30 
OAV02S40 
UAV0?b50 
OAV02560 
OAV02570 
OAV02580 
DAV02590 
0AV02600 
DAVfl2bi0 
DAV02620 
OAV02630 
DAV02640 
DAV02650 
OAV02660 
DAV02670 
DAV02680 
0AV02690 
OAV02700 
0AV02710 
DAV02720 
DAVO2730 
OAV02740 
OAV02750 
DAV02760 
0AV02770 
DAV027B0 
DAV02790 
OAV02HOO 
DAV02810 
DAV02820 
DAV02H30 
UAV02H40 
DAVOPS^O 
DA  /02860 
OAV02H70 
OAV02HP0 
OAV02H90 
DAV029O0 
OAV02910 
DAV02920 
UAV02930 
DAV02940 
DAV02950 
DAV029GO 
UAW(i2970 
DAV029H0 
l)AV02990 
DAV03000 
OAV03(J10 
OAV03020 
(IAV03030 
DAV0304(( 
l)4V03050 
UAV030A*0 
DAV03070 
OavOJOHO 
OAV03090 
DAV03100 
DAV031 1 0 
DAV03120 
DAV031 30 
DAV031 40 
DAV03150 
0AVU3150 


3.0-2  0 


FILFJ  0AV0N2 
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THIS  ENOS  ONE  niHENSIONAL  SEAHCM  ON  K 


XBAR ( I) sXbAB ( 1 ) ♦P(l) 
31  CONTINUE 
PFTUHN 
ENO 


OAV03170 

DAVOaiBO 

OAV03190 

OAV032O0 

Bsr.iiis 


9/ 


riLFt  DAV0N3 


SUPPOUTINE  04VDN3(FXiFXl .P,M»HV) 


n*VDN3 


- 

FX**«»  - 

FXl**«  - 


p««« 


THE  M MATRIX  AND  THE  P MATRIX  FOR  THE  NEXT 
^ EAHCM, 


UPDATES 

ctclf  Through  the 
thp  h matrix  is  prought  In  to  core  one  row  at  a time. 

SCRATCm^FILES  7 AND  28  ARE  USED  TO  STORE  AND  UPDATE 
This  matrIx. 

NU“PFR  OF  VARIABLES 

TION  BEING  MINIMIZED 
TH  RESPECT  TO  NFW  H-MaTR!X) 

. - T AT  THE  BEGINNING  OF  THE  CYCLE. 

(PARTIAL  UEM.  WITH  respect  TO  OLD  B-MATRIX) 

THC  H raTRIX  approximates  THE  INVERSE  MATRIX  OF 
pa-TIal  derivatives. 

VECTOR  USED  IN  UPDATING  THF  M-MATRIX 
VECTOR  CORRESPONDING  TO  SEARCH  DIRECTION 
(H-P.ATRIX  TIMES  THE  GRADIENT) 


gradient  of  fun 

(PARTIAL  OER.  w 


CSFNn 


in 


r* 

c 


TNCLIIOF  COmokT.LJ'^T 

rOMMON/FSl./CFAC.TOTMSR,SEPMSfi,PRCKEY.CRIKFY,INCFET. 

• INCVEC(TO) ,IC0UnT.SFTw6T.EVALPF( 1001 tFFTVC*(30) 

• .NDFtTA,VARS74,CORHAS.OTAP4,WGMSlA.BFSTVC(10) tOIVSlZ 

• . ST  at  < Y . aDRESD . AOSESP . ADRESF • ADRSHl » AD&SH2 
INTEGER  AnRFSO.ADRESP.ADRFSF.ADWSHl.ADHSHZ.STATKY 

double  precision  cfac.totmsr.sepmsr 

DOUBLE  PRECISION  DEOK .CAYMIN.CCAY.EIl 
double  precision  sigyi.yhy.delxex 

DOUWLE  precision  ex (N) .EXl (N) ,P(N) .H(N) .MY(N) 
COMMON/OVNBLh/OEOK.CAYHlN.FlI.CCAY.llO. UDMFN.ITT.ICNT.N 
n?=n*2 

kaDsAOOShI 

I AU=ADP'iM2 

lE(POU(irKT.?)  .EQ.DGO  TO  10 

K AUsAr'C.1,^1^ 

I A<nTAORS-<  1 
TOUT  I'll  It 

CALL  RRFaO(ADRESE,Ex1.N?, ISTAT) 

'iNivAC  CM»-c<  drum  status 

OEI  XEX=0.0 
JAflrKAD 

no  40  I = I . N 

npl.xEXsnELXFX  ♦ P(I)*EX(I)/CAYMIN 
HY ( I ) =0.0 

READ  our  '-“0.  uE  IHE  M MATRIX 
CALL  "'RPA(,i(  JAD.M.N/J.lBTAT) 

UNIVAC  C*'tC'  0-^UH  STATUS 
jAn= jAn»N<' 


♦ R(J)*(EX(J)-EX1(J)) 


?o  no  10 

10  HY ( I ) =hy ( I ) 

40  rONTIMJf 
YHYsO.n 
SK-yIsO.O 
no  BO  TsI  ,*i 

SIGYIsSIGYI  . P(I)4(EX(I)-EX1 (I)) 

BO  YHY=YHY  ♦ (LX(l)-EXl (I) )*HY(i) 

TE(SIGYl.LT,1.ri-3h  .OR.  YHY  .LT.  1.0-36)G0  TO  00 
no  6B  1=1. N 
BX  1 ( I ) = 0.  (1 

CAl  L RREAU (X An.H.N?. ISTAT ) 

UNIVAC  CHIC*>  f)wUH  status 

KAO  = H An.N? 

UPOiTE  This  fiOl  OF  The  h MATRIX 
ss  no  GO 

H(.))  = H(,l)  ♦ R(I)*P(J)/SIGYI  - HY(I)«HY(J)/YHY 

40  rOf'TINUE 

00  G1  J=1  .% 

USF  EX)  ST0'-'A(9C  to  UPHATE  P ARRAY 

EX)  ( I ) =FX  1 ( T ) - h( J) ‘EX ( J) 

4)  rONTTNUP 
c*  kRTTE  UHDAiro  H 

CALL  R4RITE  (LAD.t'.N?,  ISTAT) 

1 AO  = LAn.(,,' 

C UN  VAC  ChLC«  DpUM  STATUS 

4B  rOMIMlf 


r* 

c* 


c* 

r* 

c* 


OAVOOOlO 

DAVOOOZO 

DAVOOOaO 

OAVOOOAO 

OAV00050 

DAVQQ060 

OAVOOOTO 

UAV00080 

DAV00090 

DAVOOlOO 

DAVOOilO 

DAV0O120 

DAVO0I3O 

DAVOOlAO 

DAVOOISO 

DAVOOINO 

OAV0OI7O 

UAVU0180 

OAVOOiSO 

DAV00200 

DAV00210 

0AV00220 

OAV00230 

(IAV00240 

OAV00250 

DAVO02NO 

OAV00270 

rAV002«0 

UAV00290 

DAV00300 


DAV00310 

DAV00320 

DAV00330 

DAV00340 

DAV003SO 

OAV00360 

0AV00370 

UAV003B0 

OAV00390 

PAV00400 

0AV00410 

OAV00420 

DAVQ0430 

0AV00440 

OAV00450 

UAV004GO 

DAV00470 

r>AV004B0 

DAV00490 

OAVOObOO 

OAVOOSIO 

DAV00S20 

0AV00530 

DAV00540 

UAVOOSSO 

DAV00S60 

DAV00S70 

DAV005AO 

OAVOUSRO 

DAV00600 

DAV00610 

DAVO0620 

DAVO0630 

()AV00b4O 

OAvOObSO 

I’AVOOfcGO 

tAV00470 


(>A  VOObHO 


OAVOOGRO 
DAV00700 
DAV0071 0 
('AV0C72O 
OAV00730 
OAV00740 
DAV007S0 
(lA  V00760 
DAV00770 
nAV(i0780 
DAV00790 


• • • 


riWFj  0AV0N3 


nroKBft.o 

no 

70  oFiK*oriK*FiMn*p(i> 


SAVE  LATEST  PAPTIALS  ON  SCRATCH  FILE 

CALL  RWRITE<AOPCSF.FXiN|«lSTAT) 
UNTVAC  check  l)«UH  STATUS 


C« 


..J^AC  cAeck  15puh 

An  3ItTf7a.300)SI6Y1«YMY 
QETUPN 


IINIVAC  C"fCK  DHUH 
ENO 


YMY.'.EIS.T) 


OAV00600 

OAVOOPIO 

DAV00H?0 

UAV00630 

DAV008A0 

QAV008S0 

hAVOOttOO 

DAVOOaTO 

OAV00P80 

OAV00890 

OAV00900 

OAV00910 

riAV009?0 

CLOSE  TO  ZERO  TO  ‘■'^°*^^gAVOo||o 

OAV00960 


FILP:  OAVION 


‘jUBPOUTINE  OAVION(COVWTX,AVEMTX,DJVT«B.><FI6HT.COVMT2.AVEHT2.StS2. 
► APTLS.WHKPY, 


OAVOOOIO 

DAV000?0 


/0003U 


C* 

c* 

r.» 


PAVION  IS  TmE  OHIVEP  moutine  fop  the  DAVIOON-FEETCMEP-POWELL 


jNCLUDF 


. I’Ll  51 

fNCLUOF  C«M-Kr.Lf5t 


PAvfldOAO 
PPODAVOOOSO 
UAV00060 
OAV00070 


:»ENn 


c* 


V* 

c* 

€• 

c* 


COHHON/INFO«h/NOCI.S2fNOSUB2tNOFFT2*VAPSZ2»TOTVT2*NOFL02t 

• Av4-»2.COVAP?tCLSI»)2tSUPN02tSlJP0S2tFCUSV2,VEHTX2. 

• FFTVCaOO)  tSUMVC2«7S»  »SU«PTp(7S)  .CLSVC2(60)  « 

• KFPPTS('»0»  tMO(jrtP,6wPNAM(ftO)  .GPP0EX(6l)  t 

• i-UPCMK  (<^1  ) ,GP0IJPS(12A) 

rOMMON/FSL/rrtC  .TOTPSP.SfcPPS^'.PPCKEY.CPlKEr  • INCFET» 

• INVFC  ( ‘^0)  . 1 COUNT, sFTWfiT. t v ALHF  (100)  ,FFTVCA(30) 

• ,N0F*'Ta»  VAkS74.C0P)3AS,0TAH4,WGMS14»HESTVC  ( 10)  .DIVSIZ 

• .STaTky. AnPtSO.AOPESP.ADWtSFfAUPSHl , AOPSM2 
TNTEGFP  aukCSO,  A1)wESP,AOwFSF,AOPSH1  , A0MSM2,STATKY 
nOUHLF  kPF.ClSlON  CFACtTuTHSP.SEPMSH 

FOnlVAlF^Ct  (1PL0CK(2> ,PCHKtv> 
nOiiHLE  PPtClSION  HMAT  (NOFtT4,NOFET2) 
niMFN*^ /ON  pi^KPY  ( 1 ) 

ni“FNSfON  COVMTX  ( 1 ) , AVEMTX(l).  wr.J(iHT(l)» 

INTtr-Fu  Ft TVC2, Ft tvC*,B*iKEY, CPI KtYtPCMKEY 
INTFGF.p  StTvOT 

COMPON/OVNPl.K/OFOK.CAYMIN.FIKCCAY.IlOtllDPEN.ITT.ICNT.N 
DOiimLF  PHtCI'ilON  (ttLF  ,F1  I ,CAYMlN,OFO«,CCAY,PAPTLS(  1 ) »SMSR 
nOllPLF  PHtCl^^ION  nivTAB(l),COVHT2(l),AVEMT2(l),S2(l) 
rcAYsi ,n-N 
IlOxl 
T lOMFN*! 

SET  - 


r* 

C* 

C* 


C* 

r* 

c* 


in 


15 


c* 

c« 

c* 


?5 


r* 

c» 

c* 

c* 

c« 


S(l) 


CONyE'pGFmCE  lOLEPANCE 


OFI  Fx)  ./>-'• 
TF  (CP  HKT.t 
TF  (CPT>'Fr.F' 
I(NT=0 


, 1 . / '.r).«.FT-JOr  .t 
, i)  CtLF  = l .(j-S 


3.2)nELF=l,n-l 


INlTlAt  IZF  «-’1ATPlX  (XOAP) 


IF(PMPPy.LF  .fi/r-O 
READ  H-“ATpTX  in 


TO  10 

single 


PRECISION,  THEN  STO»E  IN  OOUPLF  PRECISION 


CALL 
1K  = 0 

no  s 
no  5 


HMFIL ( wpkPY.NOFE  r4,NOFET2,FETVC?,2) 


?0 


1=1  ,^'^FFT? 

.1=1  ,'.0PFT4 
IK=I«*1 

PMAT ( J. I ) LY  ( IK  ) 

GO  TO  ?0 

initialize  S-MATpIX  FHOh  'HEST*  set  founo  in  without  PFPLACEPFNT 

CAl  1.  OPOFP  (FF  fVCA.NOFf  TA  ) 
no  15  1 = 1 ,r.')FFT<. 

00  l*^  J=1.^.')FET2 

hmat ( I . j) =n. 0 

IF(FFT\'C<*(I)  .f'-.FETVC2(Jl  )P*^AT(I,J)  = l.n 

INITIAIIZA  snuTU.r  FOP  fVALUATING  PAPTIAI.S  ANp  SFP.HFASUPE 

CALL  FInT  1 (COVYTX, AVEPlA,nlvTftP.»EIGHT,S,S?.COVHT?, AVFMT2,PAPTLS) 
ITT  = f> 

COMPUTE  PAJTlAI.  S EOH  initial  H-''ATP1X 


IPAPTsT 
CALI  rjh'' 
COMl'lii«- 
ITTrllT*! 
r I T=cmSP 
N=NOFFT?*'.OPMa 
LEFT=IWFKS/-N“? 

IPsPASF  AOOHPSS 
IFsPAsr  anii.n'-,*; 
1HY=PAS^  AnnPFSS 


(sHSP.  IPAHT  .HhaT,i.PkHY,  Il»HKSZ»C^^S) 


Ft)0  P AhHAY 
FI'W  M APPAY  (ONLY 
F f)P  HY  APPAY 


ONE  POh  OF  H IN  COHF  AT  A TIME 


OAVOQOPO 

DAV00090 

DAVOOlOO 

DAVOOjlO 

OAVOOIZO 

PAV00130 

OAvnoiAO 

OAvnoiso 

DAVOOlnO 

DAV00170 

OAVOOIAO 

UAVOOlvO 

DAV00200 

OAV00210 

DAV00220 

DAV00230 

(IAV00240 

UAV002S0 

0AV0026U 

DAV00270 

OAVOOZBO 

OAV00290 

DAV00300 

OAV00310 

OAV00320 

OAV00330 

OAV003AO 

OAV00350 

0AV003F.0 

OAV00370 

OAV003H0 

t)AV00390 

OAV00400 

OAV00410 

OAV00420 

DAV00A30 

OAV004A0 

tiAVOOAbO 

OAV004N0 

OAV00A70 

UAVOOAMO 

DAV00A90 

(lAvooson 

(JAV00510 

DAV00520 

POAVno530 

DAVOOSAO 

OAV005S0 

DAV00550 

DAV00570 

OAV0O5HO 

DAVnosco 

OAvOOnno 

oavoomo 

DAV00620 

UAV00630 

OaVOOGaO 

uAVOonso 

OAVOOnNO 
MAVOObTO 
I'AvnonMO 
OAVOOHPO 
f.AVdo  )O0 
OAvnoTlO 
OAVdOTZO 
OAV00730 
OAV007A0 
OAvnn7so 

OAV.i  17H0 
(JAV(i()770 
UAV007HO 
OAV007N0 


Fleet  DAVION 


C* 

r* 

c« 

c* 

c* 


c* 

c* 


c* 


c* 


r« 

c* 

c* 

c« 


c* 

c« 

c* 


c* 

c* 

c* 

c* 


c. 


^0 


1h«1p*N«2 

Fi»!HV*N«2 
TFST«IF14N*2 
F(ITEST.LF.l 
WRTTF(A*lOO)i 
CALL  CMEHR 
CONTINUE 


WRKS7)G0  TO-  30 

MRKSZ 


initialize  w and  P ARRAYS  - SAVE  H ANO  PARTLS  ON  SCRATCH  FILE 

ALSO  cnOMPUTP  INITIAL  OFOk 

CALL  OAVONl IPAPTLStWHKRY (IP) .WRKRY(IH) ) 

PARTLS  STOHA(iF  CAN  MO»i  HE  USED  IN  0AVI0N2  FOR  TEHp.  STORAGE  OF 
OAVON^  RETURNS  A NFW  B-HATPIX  ANU  P ARRAY  ANO  CAYHIN 
AO  CALL  0AV0N2<BMAT,pARTLS»«#RKHY(IP)  ,(tRKRY«lH)  *LEFT*A50) 

N2=2*N 

SAVE  P ARRAY  ON  SCRATCH  FILE 
CALL  RwR1TE(AORESP.*<HKRY<IP)  *N2*LSTAT) 

WAIT  FOR  I/O 

Al  IF(LSTAT,EO,l)GO  TO  41 
TF(LSTaT.NE.0)GO  TO  70 
COMPUTE  NEW  PARTIALS 

CALL  FINT2(5MSR»lPAWTtBMAT»WRKRY»IWRKSZ»«.45) 

45  CONTINUE 
1TT=1TT*1 
ICNT=ICNT*1 
5EPMSR=SMSR 

lF(OARS(SMSfl-EII  ).LI.0ELF)60  TO  50 
EI1=SMSP 

IF(ITT.GE.ICOUNT)GO  TO  50 

SMSR=5EPMSR 

READ  BACK  P ARRAY 

CALL  RREA0(4r)PESP.WRKRY(IP)  .N2.LSTAT) 

45  IF(LST4T.E0.1)G0  TO 
lF(LSTAT.NE.O)r-o  TO  70 


SUBPOUTI.viE  OAVON3  UPDATES  ThF  H AND  P ARRAYS  AND  SAVES  NEW 
H AND  NPw  PARTIALS  ON  SChaTCH  FILE 


CALL  DAVO'-iB  (PARTLS*  WRKRY  ( IF  1 ) ,WRKRY  (IP)  .WRKRY  ( IH)  ,WRKRY  ( IHY) ) 
GO  TO  40 

IF  CRITERIA  = AV.  DIVERGENCE  - COMPUTE  INTERCLaSS  DIVERGENCES 
50  IE(CPIKEY.NP.l)GO  TO  50 

CALL  niVRGl {C0VMT?,VARS74,AVFMT2,0IVTAB.N0CLS2tN0FET4* 

* wPKRYt IWRKSZ) 

50  CONTINUE 

STORE  IN  single  PpECISIOn  ARRAY  AND 

WRITE  B-MATPIX  ON  FILE  AND  PUNCH  ON  CARDS  IF  REQUESTED 
IK=0 

no  65  T=1.NDFFT2 
no  55  J=l.nnEET4 
1K=1K*1 

WPKMY (IK) =H"AT ( J, I ) 

55  CONTINUE 
MMKEY=I 

CALL  HPFTL  (*.RhRY,I'OFET4*NOFEr2,FtTVC2t51 

IF (PCHkey.K'J. 1) CALL  HmFIL 'wHKpy.N0FET4«N0FF I2.FETVC2.4) 

return 

70  WRTTE<5,?00)L5TAT 

100  FORMAT  (•  NOT  ENOUGH  W('RK  AREA  AVAILA-GLE  IN  DAVION — |WRKS7=*»I6) 

200  FORMAT  (/•  ERROR  ON  DRUM  FII.E  - SURROUTINE  OAVlI.N LSTA1s»,I?) 

END 


DA/00800 
DAV00810 
OAV00820 
0AV0Q830 
OAV00840 
DAV00850 
0AV00860 
DAV00870 
DAVooeeo 
DAV00890 
DAV00900 
DAV00910 
DAV00920 
XBAOAV00930 
DAV00940 
DAV00950 
OAV00960 
OAV00970 
DAV009P0 
DAV00990 
OAVOIOOO 
DAVOlOlO 
DAV01020 
0AV01030 
DAV01040 
DAV01050 
OAV0IO5O 
OAV0107U 
OAVOIORO 
DAV01090 
OAVOllOO 
DAVOlilO 
nAvoii2o 
OAVC1130 
0AV01140 
OAVOllSO 
OAV0116O 
OAV01170 
OAVOllPO 
DAVOllPO 
OAV01200 
OAV01210 
DAV01220 
DAV01230 
DAV01240 
OAV01250 
OAV01260 
DAV01270 
OAV01280 
OAV01290 
DAV01300 
DAV01310 
0AV01320 
OAV01330 
OAV01340 
DAV01350 
DAV01360 
OAV01370 
OAV01380 
DAV01390 
DAVOl AOO 
OAV01410 
DAV01420 
DAV01430 
OAVOlAfcO 
OAV01450 
0AV01460 


A 


V 


103-2-5^ 

9^ 


FILE*  OIVERG 


SUBROUTINE  DIVEPG(COVMTX«V«RSIZtAVEHTX*OIVTAB*NOCLS« 

* NOFET«mRKRY« IWRKSZ) 

c* 

C*  SUBROUTINE  TO  COMPUTE  INTERCLASS  DIVERGENCES 

C* 

INTEGER  VARS17 
nOURLE  precision  wRKRV(1),T 
ROUBLE  PRECISION  OIVTflB.OETtTRACE 

niMENSION  rOVMTX(VARSIZ.NOCLS) * AVEMTX(NOFETfNOCLS) t 

* DIVTAH(I) tT(30) 
inp=i 
GO  TO  3 

ENTRY  DIV:?GI (COVmT?,VARSI7.AVEMT2.0IVTAB.NOCLS.NOFET.WRKRY»IWRKSZ) 
nOHBlE  PRECISION  COVMT2(VARSIZ»NOCLS) »AVEMT?(NOFET*NOCLS) 
inp=n 

3 CONTINUE 
TCVl=l 

ICV2=1CV1*VAPSIZ 
IW1=ICV2*VARSIZ 
1W?=IH1*VAHSIZ 

IF(1WRKSZ/2.GE.IR?*VARSIZ)G0  TO  ♦ 

WRITE  (E.,200)  IWRKSZ 
CALL  CMEHR 
A CONTINUE 
MN=n 

IC=NOCLS-l 

no  30  1=1, ic 

C*  FIND  INVERSE  FOR  CLASS  1 COVAR.  MATRIX 
no  1 1K=1.V4RSTZ 

IFdnP.EO.  1)wP«HY(IK1=C0VMTX  (IK,n 
IF( inP.EO.O) WRKRY( IK) =C0VMT2 ( IK, I ) 

1 CONTINUE 

CALL  COLlNV(WRKRYdCVl)  ,NOFET  , lERR  , 3,0ET ) 

IF(IERR.FO.O)GO  TO  2 
WRITE  (f,,  100)  I 
GO  Tf> 

2 Tm=I*1 

no  ?0  U=IM,NOCLS 
mn=mn»i 

no  S II=1,N0FET 

IFdnp.EO.DT  <1I)  = AVEMTX  (II,I)-AVEMTX  (II,  J) 

IF(ir'P.E0.0)T(II)=AVEMT2dI,I)-AVEMT2dI,J) 

S CONTINUE 
K = 0 

no  in  II  = l,^'nFET 
no  10  JJ=1.1I 
K=K*i 

IFdnp.EQ.DGO  TO  6 
WRKRY (ICV?*K-1) =COVMT2(K, J) 

WRKRY  ( IWl  *K-1  ) =C0VMT2(K,J)  ♦ TdI)*T(JJ) 

WRK«Y(1W2»K-1)  =COVMT?(K,I)  ♦ T(II)*T(JJ) 

GO  TO  10 
CONTINUE 

WRKRY ( ICV2+K-1 ) =COVMTX (K,J) 

WRKRYdW1*K-D  =COVMTX(K,J)  ♦ TdI)*T(JJ) 

WRKRYdw2*K-l)=COVMTX(K,I)+T(lI)*T(JJ) 

10  continue 

C*  find  inverse  for  CLASS  J COVAR.  MATRIX 

CALL  COLINVIwRKRYdCV?)  .NOFET,  I£RR,3,OET) 

IF( iEWR,Eo.n)Oo  ro  is 
wRITF(s,lfiO)  J 
GO  TO  ?0 

IS  DI VT AR ( nn )=. S*( TRACE (WRKRY (I CVl) ,WRKRY(IW1) , NOFET) 

* ♦ TWACF (WRKRY ( ICV2) ,WPKRY ( 1W2) , NOFET) ) - NOFET 
?n  rONTTNUF 

3fi  continue 

RPTUPN 

inn  F()RWAT('  CnvAP  LOR  CLASS'.IA,*  is  not  positive  DEFINITE*) 

?n0  FOPfiATC  NUT  enough  work  area  available  in  niVERG  — IwRKSZ=',I5) 

FNO 

1 


>e-2  6 


J 


FILFI  EV*LSP 


C« 

C» 

C* 

C* 


C 

C 


SUBROUTINE  EVALSPf  SMS«*COVMTX» AVEMTX.S.COVMT?, AVEMT?.S2t 
* OlVTAHvWElGHTtlPABTtPABTLStBMATtkBKRYtlWBKSZ) 


THIS  SlIRROyTiNE  COORDINATES  THE  ROUTINES  FOR  COMPUTING  THE 
MEASURE  FOR  A PARTICULAR  LINEAR  COMBINATION  0 


OR 


CSFND 


SET  OF  FEATURES 

DOURLF  PRECISION  SMSR»C0VMT2<1)  .AVEMTZd)  »S?(l)  tDiVTABdl 

• *PA»TLS ( U .HMaT d ) 

INTEGER  crikey 
INCLUOF  COMoKI.LIST 
INCLUDE  C0HRK?,LIST 

COMMON/ INF0'?M/N0CLS?*N0SUB2. NOFE 12, VARS7?» TOT VTP.NOFLOZt 

• AVAH?,CnVAH?,CLSID2»SURNO2,SlM0S?,ELOSV2,WEHTX?, 

• E£TVC2(30) ,SUHVC2(7S) ,SURPTk(75) ,CLSVC?(60) » 

• KEHPTStNO) iNOGHP.6HPNAM<60) »GRP0EX (6l » , 

• GRRCHK  <M»  .GROUPS  (12A) 

COMMON/ESL/CE AC, TOTMSR,S£PMSh,PRCKEY. CRIKEY. INCEET, 

• INCY£C<10) . ICOUNT.SFTRGT.EVALRE  dOO) .EFTYC* (30) 

• ,NOFET4,v«RS74,COMHAS.OTAH4,RGHS14,BESTvCdO»  .OlVSIZ 

• ,STATKY.4nR£SD,AnRESR,ADRESE,AnPSHl»A0RSH? 

INTEGER  6!)»F‘;0,A0R£SP,ADRE5E,AORSHl,AnR5H2,STATKY 
nOU«l.E  PRECISION  CFAC.TOTMSR.SFPMSR 


niMFNSTON  COVMTXd),  AVEMTXd), 
wFIGMld)  .IMAWTd)  ,WRKRY(1) 


SCI) 


c* 


c* 

c* 

c* 


c* 

c* 

c* 


40 


TFUL1.=0 
GO  TO<10, 20.30, 40) .CRIKEY 
WEIGHTED  average  OIVEPGENCF 
10  CALL  AVEOIV(SHSR,COVMTX,S,COVMT?,S2, VRKRY.IWRKSZ, 

* IPAHT.PARTLS.BMAT.IFULU 
RETURN 

weighted  average  transformed  DIVERGENCE 

?n  CALL  TPnOIV (GMSH.COVMTX. AVFMTX,COVMT?,AVEMT2, 

* WEIGHT, OIVTAH.WRKRY, 

* IwRKSZ.IPaPT.PARTLS.BMAT, lEULL) 
RETURN 

WEIGHTED  AVERAGE  HHATTACHA»YYA  DISTANCE 

3ft  CALL  8HTCHH(5MSR,C0VHTX,4VFmTX, WEIGHT, OIVTAB, 

* COVMT?,AVPMT2,WRKRy. 

* IWRKSZ, IPART.PARTLS.BPAT, IFULL) 
CONTINUE 

return 

END 


EVAOOOlO 
EVA00020 
EVA00030 
CVA00040 
EVA00050 
FVA00060 
FVAOOOTO 
EVAOnORO 
FVAOOORO 
EVAOOlOO 
EvAooIio 
EVA00i?0 
EVAO013II 
FVA00140 
EVAOOISO 
EVAOOIGO 
EVA00170 
COMOOOlO 
COM00020 
CON00030 
COM00040 
COMOOOSO 
cOMOonbu 
EVA00250 
FVA002G0 
EVA00270 
EVA002R0 
EVA002R0 
EVA00300 
EVA00310 
FVA00320 
KVAO0330 
FVA00340 
FVA003S0 
FVA003GO 
FVA00370 
e VA003B0 
FVA003R0 
EVA00400 
EVA00410 
EVA00420 
EVA00430 
EVA00440 
LVA004S0 
EVA004GO 
EVA00470 
FVA004B0 
EVA00490 


97^ 


0 00^0 


FILEt  EVLFET 


8 


CSENO 


SUPHOUTINE  EVLFenC0VMTX.AVEHTX.0IVTAB«WEIGMT»C0VMT2fAVEMT?. 
' ^ i»S2«Wf«KRY»IWHKSZ) 

INCLUDE  COM^Kl.LIS 


INCLUDE  COM*in7,Lrsi 

COMMON/ INFO&^VNOCl  S2.NOSUP?»NOFET?. V ARSZ2. TOT VT2.N0FLD2* 

AVA»?.C0VA«?.CLSI0?.SU«N02»SUPUS?.FL0SV2*VERTX?f 


FETVC2(30) «SUBVC2(75) .SURPTR ( 7S» .CLSVC2 (60) • 
KFPPTS(60) »NOGHP*GRPNAM(60) tGRP0EX(61) * 
GRPCHK(aI)  ,(;roUPS(124) 

COMMON/FSL/CFAC*TOTMSP.SEPMSR»PRCKEY.CRIKEYt INCFET* 
INCVECnO)  .ICOUNT.SETWGT.EVALPF  (100)  .FETVCAOO) 
.N0FFT4.VAH574.C0«HAS.DTAH4tWGHSlA.BESTVC(l0) tOIVSIZ 
.STATi<Y,AOHFSn«  AOHE5P.  ADHESFtAORSHl.  A0RSH2 
INTEGER  *0r(FS0,AnPESP.A0PESF»A0PSHl.A0RSH2.STATKY 
DOUBLE  PkECISION  CFaC. TOTMS«»SEPmSR 


Pf^ECTFION  C0VMT2{1),AVEMT2(1)  ,52(1)  fOUM(l)  ,DIVTAB(l) 
INTEGER  VA«^^Z*,FETVC4 
INTEGER  CRIKFY 

DIMENSION  AVEMTX(l) ,C0VMTX(1) , WEIGHT(l)* 

» S(l>.  *i'ftKfiY(l) 

IPART»-1 

CALL  GTSTAT (COVMTx,AVEMTX,S.COVMT2»AVEMT2tS2»FETVCA* 

► niN.i^WKRY.  IWHKS7) 

CALL  EVALSP(SFPRSR,C0VMTX,6VEMTX.S*C0VMT2,AVEMT2,S2tDIVTAB, 

* i«F1GHT,IPART.DUM,0UM,WHKRY»IHHKSZ) 

IF(CRIKFY.NF. 1 )WETURN 

CALL  OIVRGl (CoVMT?,VARSZ4,AVEMT2t0IVTAB»N0CLS2*N0FET4»WRKHYf 

* IwRKSZ) 
return 

F^n 


EVLOOOlO 
EVL00020 
fVLOOOSO 
EVLOOOAO 
EVL00050 
EVL00060 
EVL00070 
EVLOOORb 
EVLOOORO 
EVLOOlOA 


CVLOOj^jj 


EVLOOl, 
EVL00130 
EVLOOIAO 
EVL00150 
EVL00160 
EVL00170 
EVL00180 
EVL00190 
EVL00200 
EVL 00210 
EVL00220 
EVL00230 
EVL00240 
EVL00250 
EVL00260 
EVL00270 
EVL002B0 
EVL00290 
EVL00300 
EVL00310 


PILE  I EXSRCH 


s; 

c* 

c* 

c« 

c 

c 


SURROUTINE  EXSRCH (C0VMTXfAVEMTX«0IVTAi}»WEt6HT«C0VMr2t 
* AVEMT2»S«S?.WHXRY.IWRKSZ> 


THIS  subroutine  uses  TmE  EXMAU 
THE  BEST  »N0FEf4»  OUT  OF  •NOPE 
SEBAPA01L1TY  measure  INOICATEO 


TIV 

i; 


SEARCH  PROCEDURE 
TURESf  ‘ 


EA 

•CRIKEY*. 


BY 


TO  PINO 

MAXIMIZING  THE 


CSEMO 


C* 

C* 

C* 


c* 

c* 


r* 

c* 

c* 

r* 

c* 

c* 

c* 


r* 

c* 

c* 

c* 

c* 


INCLUnp  COMOKl.LIST 
TNCLUOF  COMbkT.LIST 

C0MM0N/1NF0OM/N0CLS2.N0SUP2.N0FET2.VARSZ2.T0TVT2.N0PL02* 

• AVAR2,COVAR?.CLS102.SURN02.SUB0S2»FL0SV2.VEflTX2f 

* FFTvC2nO)  .SUyvC?(7S)  .SUHPTR(75)  .CLSVC2(60)  t 

• KFRPTS(K0> •N0GRP.6hPNAM(60) «GRP0EX(6U • 

• PRPCHK(iSl)  .GROUPS  (124) 
COMMON/FSL/CPAC.TnTMSP.SEPMSR.PRCKEY.CRIKEY.INCFET* 

* iNCVECno)  .ICOUNT.SETW6T.EVAL8FUOO)  .FETVC4O0) 

• .NOFET4,VARSZ4.CO«BAS»OTAa4.WGHSU.BESTVC(10) .DIVSIZ 

• .ST  ATK Y . AORESD ♦ AORESP , AOPESF . AORSHl * AQRSH2 
INTEGER  A(>RFSD.AOPESP.AORFSF. AORSHl .A0RSH2.STATKY 
noURLE  PRECISION  CFaC.TOTMSR.SEPMSR 

INTEGER  FETVC?.FFTVC4»TVEC»VARSZ2.VARSZ4 
INTEGER  OIVSIZ.SVFCOO)  .CRIKEY 
double  precision  tmsr.oivtah (DIVSIZ) .DUM(i) .dm 
DOUBLE  PRECISION  COVMT2 ( V ARS74. 1 ) . AVEMT2 (N0FET4. 1 ) .S2 ( VARSZ4 . 1 ) 
DIMENSION  COVMTX(VAWSZ2.NOCLS2)  . 

♦ 4VEMTX(N0FET2.N0CLS2)  ♦ 

* S(VAPSZ?.N0CLS2) 

DIMENSION  TVECnO) 

DIMENSION  WF1GHT(1).WRKRY(1) 

initialize  tvec  eoh  getset  routine 

no  1 Isl.NOFETA 
1 TVFC(I»=I 

TVFC (nOFETA) =MOFtTA-l 

SFPMSR=1.E*1S 

GET  NEXT  SET  OF  FEATURES 

4 CALL  GETSET (TVEC. NOFET4.NOFET2. LAST) 

IF(LAST,EU.O)GO  TO  10 

get  SUBSET  OF  STATISTICS  FOR  THIS  SET  OF  FEATURES 

CALL  GTSTAT (COVMTX . AVFMTX .S .C0VMT2. AVEMT2.S2. TVEC.OM. WRKRY. IWPKSZ 

EVALUATE  SEPAWahILITY  MEABIJRF  FOR  THIS  SET  OF  FEATURES, 

SET  IPART  SO  partial  OERIATIVES  VRL  NOT  BE  CALCULATED. 

IPART=-1 

CALL  EVALSP (TMSR.COVMTX. AVE«TX.S,COVMT2. AVEMT2.S2.0IVTAB. 

* sEIGHT, IPART.OUM.OUM.WRKRY. IWRKSZ) 
TE(SFPMSf<.LT.TM5R)G0  TO  4 

no  S I=1.mOFFT4 
KrTVFCd) 

«VPC(I)=K 

5 FETvr4(I)=FFTVC2(K) 

SFPMSR=TmSR 

GO  TO  A 

finishfo 

COMPUTE  INTFRCLASS  MEASURES  FOR  FEATURES  CHOSEN 


10  CONTINUE 

CALL  GTSTAT (CC)WMTX .AVFMTX.S.COVMT?. A VFMT?,S2.SVFC,0M, WRKRY. IWRKSZ 
CALL  EVALSP (SFPMSR.COVMTX, aVEMTX.S.COVMT?, AVEMT2.S2.DIVTAB. 

* weight. IPaRT .nUM.DUM. WRKRY, I WRKSZ) 
lEfCPIKEY.NF.l )RETUWM 

CALL  OIVRGI (COVMT?. YARS74, AVEMT2.OIVTA8.N0CLS2. 

* NOFETa. WRKRY. IwRKSZ) 

20  return 

ENO 


EXSOOOlO 

EXS00020 

EXS00030 

EXS00040 

EXS00050 

EXS00060 

EXSOOOTO 

EXSOOOBO 

xsooiio 

_XS00l20 

COMOOOIO 

COMQOOfO 

COM00030 

COM00040 

COMOOOSO 

COM00060 

EXS00220 

EXS00230 

EXS00240 

EXS0Q250 

EXS05|60 

EXS00270 

EXS00280 

EXS00290 

EXS00300 

EXS00310 

EX500320 

EXS00330 

EXS00340 

FXS00350 

EXSO03G0 

EXS00370 

EXS003BO 

EXS00390 

FXS00400 

EXS00410 

EXS00420 

EXS00430 

EXS00440 

EXS004S0 

)EX500460 

EXS00470 

EXS004BO 

EXS00490 

EXS00500 

Exsonsio 

EXS0J520 

EXS00530 

EXS00540 

EXS00550 

EXS00S60 

EXS00S70 

exsoosBo 

EXS00590 
EXS00600 
EXS00610 
E.XS00620 
EXS00630 
EXS 00640 
EXS00650 
FXS00660 
)FXS00670 
EXS006B0 
FXS00690 
EXS00700 
FXS007I0 
EXS00720 
FXS00730 
EXS00740 


FILFI  FlNTl 


r* 

r. 

c* 

r* 

c* 

?: 

c» 

c* 

c* 

r 

s 


SUBROUTINE  FINTl (COVMTXt AVEMTXtPlVTAB»MEI6HT*StS2»C0VMT2t 

» avemtz»parti.sT 

this  subhoutine  is  a driver  for  obtaining  the  partials  and/ 

OK  SEPARABILITY  HEASURE  FOR  ThE  OAVIOON  PROCEDURE. 


— THF  FIRST  ENTRY  POINT  (FINTII  l« 
lONG  argument  list.  ANO  PRINTIN? 
characteristic  summary. 


FOR  initializing  ADDRESSES  FOR 
THE  HEADER  FOR  CONVERGENCE 


r.SFMn 


—entry  point  F1nT2  must  be  called  for  each  evaluation  of 
THE  separability  MEASURE  OR  PARTIALS 

fOVMTX  - (INPUT)  COVARIANCE  MATRIX  FOR  EACH  CLASS. 
tncludf  com-ka.list 

TNCLUOF  COM^ki.LIST 
INCLUDE  COM'KY.LIST 

COMMON/ INEONM/NOCLS?.NOSUfl2,NOFET2.VARSZ2.TOTVT?.NOFL02. 

AVAR?.C0VAR?.CLSID?.SUBN02.SUHDS2.FL0SV2.VERTX2, 
EETVC2(30) .SUBVC2(75) .SUBPTR(75) .CLSVC2(6oT* 
KEPPTS<<.0)  ,NO(>RP,6hPNAM(60)  .GRPDEXtGl)  . 
GRPCHK(M)  .groups  (12A) 

C0MM0N/6L0HAL/HEAD(ft3) . MART aP. OAT APE. SAVTAP.BMFILE.BMKEY. 

HISFIL.HISKEY.TREORM.ERIPTP.ERPKEY.MaPUNT.NOFILF. 

nPUMAn.DRMv^OS.PAGSIZ.DATFIL.STAEIL.ASAV.ASAVFL 

.NhSTUN.NMSTEI.SCTRUN.MAPEIL 

.nOTlINT.OOTFIL.NCHPAS.TRNSEL.BMTREL.HISTFL.PCMUNT, 

CRnUNT.PHTUNT.RANOIO 

common/fsl/ceac.totmsr.sepmsp.prckey.crikey.inceet. 

INCYEC  (30)  .ICOUNT.SETWGT.EVALBE(IOO)  .EETVCAOO) 
,NOEETA,n/AWS74.CDR8AS.OTA8A.W6HS1A»RESTVC(10) .DIVSIZ 
. ST aTky . AORESO. AORESR. AORESE . AORSHl . A0RSH2 
INTEGER  A0RFSn,AURESP.A()RESE.A0PSHl.ADRSH2,STATKY 
douple.  precision  CEAC.TOTMSR.SEPMSR 


AVEMTX (N0FET2.N0CLS2) . 

AVEMT2(N0EET*.N0CLS2) 


integer  VARS7P.VARSZA 
n I MENS  I ON  C0VMTX(VARSZ?.N0CLS2) 

* S(VAPSZ2.N0CLS2) . WEIGMT(l) 
double  precision  C0VMT2(VARSZA.N0CLS2) 

* . S?(VARSZ4.N0CLS2) . 

* DIVTABd)  .RARTLS(I) 

DOUm.E  PRECISION  OUM, RATIO. SPSR 
INTEGER  CRIKEY 

dimension  FRM(46) .VFRM(3) 

COMMON/ENTDIJM/  ITT.  ICYCLE 
dimension  D'Iv(1) 

DATA  VF»JM/.  , 1 hD«  . • , IHT  • ♦ • . IHH*/ 
data  ADATA/*2H/  »/,  ADATAP/i .T98*/ 

DATA  EPM/ I (///», ./ASX . . • . 34H* , tCONV* . »ERGE* ♦ 'NCE  • .» CHAR ».» ACTE • . 

1 'RIST'.'IC  S*.'UMM4«.»RY/3i.»5X.1'.*OHEU*.'NCTIi.'ONAL*.'.T59*. 

2 • , lf>M«  , .EUNC* . »TIONt  , I AL  V . • ALUE*  . • .TOA*  . ».  SHR  AT  10*  .» /?0X  • . 

3 *,SHr*,*YCLE*.*»T3S'.'.llH*.*EVAL*.*UATI*.»0NS,».*T66  •.*  *. 


•2H  /*.* 


'.•/IX  •.•,T67«.*.1HR*.*.T96*. 


r* 

C* 

C* 

C* 

C* 

C* 


A I • Tos • . • • , • 

S t , IHO I , */)  */ 

ITT=n 
ICYCLFrO 
WRITE  (fi.HEA'’') 

V'RTTF  (G.  100) 

WRITE (ft.200)MOEFTA.ICOUNT 
GO  TO  (I0./O,30) .rRlKEY 
10  wPiT^  (S.  JilO)  TDTMSR 
GO  TO  AO 

?0  WRITE  (^'.AOO)  TOTmSH 
GO  TO  AO 

30  WRITE (6.S00) roTSSM 
AO  ER>1  ( ->s)  =VF  WM  ((■«  I^EY) 

EPm(37)=vER-^(CD1kFY) 

ERM ( AO) =VFRM (fWInEY) 

IF (CPIKFY.NE, ) )Fhm(39) =ADATA 

TE(CPIKFV.|mF,  1 )Fhm(44)  =aUATA2 

WRTTF  (Fi.ERM) 

PETURI) 

FNTRY  FINT2  (SPSP.IPART .HMaT.WRaRY.IWRKSZ.*) 

SPSR  - SEPARABILITY  MEASURE  HFTURNF.O  FROM  EVALSP 
IPART-  TRTGGFtv  TO  COMPUTE  PARTIALS  OR  NOT 

- LFSS  T^'AN  0 - COMPUTE  PARTIALS 

- GWFaTFR  than  0 - DO  NOT  COMPUTE  PARTIALS 
BMAT  - H-MAIRIX 


NOOOlO 
H00020 
N00030 
N00040 
N00050 
N00060 
NOOOTO 
NOOOBQ 
N00090 
FINOOIOO 
EINOOIIO 
FINOOizO 
EIN00130 
EIN00140 
EINOOISO 
EIN00160 
FINOOIZO 
FINOOIBO 
F1N00190 
EIN00200 
E1NOO210 
FINOOZZO 
EIN00230 
FIN00240 
FIN00250 
FIN002(S0 
EIN00270 
EIN002B0 
E1N00290 
EIN00300 
EIN00310 
EIN00320 
F1N00330 
F1N00340 
EIN00350 
EIN00340 
EIN00370 
EIN003B0 
FIN00390 
FIN00400 
FIN00410 
E1N00420 
FIN00430 
EIN00440 
EIN00450 
EIN00460 
EIN00470 
E1NO04B0 
EIN00490 
FIN00500 
EINOOSIO 
EIN00S20 
FIN00530 
EIN00540 
E1N00550 
EIN00560 
FIN00S70 
EINOOSeO 
EINOOSRO 
E1N00600 
EIN006I0 
E1M0C620 
E1N00630 
E IN00640 
FIN006S0 
E1N00460 
EIMOO670 
EIN006B0 
EINOOh90 
EIN00700 
FIN00710 
EIN00720 
EIN00730 
FIN00740 
F1NO07S0 
FIN00760 
E IN00770 
EIN007B0 
EIN00790 


'fOii 


POOH  Q'AAirrv 


•••  •••• 


1 


FILPI  FINTl 


WRK^V.  wmKING  STORAGE 

TWRKZ-  SIZE  OF  WRKHY  IN  COMPUTER  WORDS 


niMENSlON  PMATM)tWRKHY(l) 

DOUBLE  PRECISION  HMATfSHSR 

OET  TRANSFORMED  STATISTICS  FOR  THIS  B-MATRIX 

CALL  «TST«T(COVMTX.AVEMTX*SfCOVMT2»AVEMT2#S2*OUM»BMAT»WRKRY. 
► IWRKSZ) 

CALL  rvALSP(SPSR.C0VMTX*AVEMTXtStC0VMT?»AVEMT2»S2f01VTABt 
» WEIGHT* IPART«PARTLS*BMAT*WRKRY*IWRKSZ) 

«MS«=nA,^s  (S°SR> 

ITTaITT*! 

TCNTxlCNT*! 

IFUCYCLE.LF.DGO  TO  50 

IF(1CNT.LF.T0)60  TO  50 

WRTTF (A.700J 

TCNTxO 

RETURN  1 

CONTINUE 

!F(IPART,LT.O)RETURN 
TCNTsO 


ICYCLE=ICYCLE*1 
IFICRIf- 


kfy.EO.DRATIOxSMSR/TOTmSR 
IF  (CRI*<t  Y .NE  . 1 ) RAT  I0*T0TM5R/SHSR 
write  (IS, 600)  ICYCLE  » ITT *SMSR. RATIO 
return 

100  FORMAT (///2SX. 'CONVERGENCE  CHARACTERISTIC  SUMMARY  FOR  THE  OAVION- 
*l ETCHER-PnwELL  PROCEDURE • /?5X , 76 ( •- • ) /) 

200  FORMAT (//3SX, 'NUMMER  OF  LINEAR  COMBINATIONS' ♦ lOX * t* •* 1 10/ 

* 35X*'0F.SIREn  NO.  OF  FUNCTIONAL  EVAL.  • *8X*  . 1 10) 

300  FORMAT(35X,'max.  WFK'MTEO  AVERAGE  DIVERGENCE  CO) • »3X * • = • «E 1 0.5) 
F0RM4T(35X,«MIN.  wEIGHTEO  AV. TRANS.  DIVERGENCE  (T)s'.E10.5) 

F0»M/ST  MSX. 'WIN.  wEIGHItD  AV.RMATTACHARYYA  dIS.  (H)  = '*E10.5) 
FORMAT (?(M,I*.T37.l4*T61.F12.7*TR0*E12.7) 


400 

500 

600 

700 


N008I 

Nooaii 
Nooaso 

888818 
Nooaao 
Nooeoo 

N00900 
N00910 
N00920 
N00930 
N00940 
N00950 
F1N00960 
FIN00970 
N00980 
N00990 
NOIOOO 
NOiOlO 
N01020 
N0i030 
N01040 
N01050 
N01060 
F1N01070 
FINOiOAO 
FFiN01090 
riNOllOO 
FINOlllO 


F 

F 

F 

F 

F 

F 

F 

F 

El 


FORMAT ( 
ENO 


MAX.  ITERATIONS  RER  CYCLE  - BEGIN  NEW  CYCLE') 


FINOl 
EIN01140 

einoIiso 

EINOllGO 

F1N01170 

EINOllfiO 


! 

( 


FILE  I 6ENRPT 


SURROUTINE  f,ENRPT  (CLSNAM. WEIGHT. 0 
OlMENSiON  CLSNAM(N0CLS2)  .WHeHTtl 
INCUUnE  C0M^K6^LIST 
OQUBLE  PRECISION  RATIO 
DOIIPLE  PRECISION  WRKAy(I)  .OIVTABm 
DIMENSION  EETVECClO) 

INCLUDE  COMWKi.LiST 
fNCLUDE  COMBnt.LIST 

COMMON/INFOHM/NOCLS2,NOSUB2.NQFET2.VARS 

AVAR2.C0VAH2.CLSI02.SURN0 


P|VTA8«WRKRY. IWRKSZ.FETVEC) 


FETVC2(T0) «SUMVC2(75>.SUB 
KFPPTS(6fl>  «NO6RP*6RPNAH(A0) t 


TRJ7S},C^|VC2C60>f 


CSEND 


GHPCHK((S1»  .fiROyPS(12*) 

COMMON/GLOflAL/HEAP(S3) .MAPTAP.OATAPE.SAVTAP.BMFILE.BMKEY. 

HISFIL.HISKEY.TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILF. 

DPItMAO.f'PMyOS.PAGSlZ.nATFlL.STAFlL.ASAV.ASAVFL 

.NHSTUN.NHSTFI.SCTRUN.MAPFIL 

,ootunt.dotfil.nchpas.tpnsfl.bmtpfl.histfl.pchunt. 

CPOUNT.PRTUNT.PANOIO 

COMMON/FSL/CFAC.TOTMSP.SEPMSR.PPCKEY.CPIFEY.INCFET. 

INCVecnO)  , ICOUNT.SETWGT.EVALBFnoO)  .FETVCAOO) 
.NOFFT4.VARS?4.COR0AS«DTAB4,W6HS14,BESTVCaO).OIVSlZ 
« ST ATKV . AORESD . ADPESP. AOPESF . AOPSHl . A0RSH2 
integer  ADPFSO.AORFSP.AORESF. AnRSHl,A0RSH2.STATKY 
DOUBLE  PRECISION  CFAC.TOTHSR.SEPMSK 

INTEGER  CRIKEY. PRCKEV 


dimension  PRC  (6 

.6) .CRI (13.4) 

data 

PHC/'F.XHA* 

.'USTI 

•.•VF  S 

• . •FARC* 

.•M 

* f * 

• ♦ 

•WITH* 

.•OUT 

• .•REPL 

•.•ACEM* 

.•ENT 

* f * 

• f 

•OAVI • 

.•OON- 

•.•flft 

•♦•CHER* 

« *-POW 

• f 

•F.VAL  • 

B- 

• .•MATR 

•♦•IX  R* 

.*EOUE 

• • 

•EVAL* 

.*.  FE 

•.•ATUR 

•♦•ES  R* 

.•EQUE 

•♦•ST 

• f 

•PFST* 

. • K 

•.  • OF 

• . • N* 

. • PA 

•♦•SSES 

•/ 

Data 

CRI/*WEIG* 

. *HTEO 

•.•  AVE 

• ♦ •RAGE* 

.•  DIV 

•♦•ERGE 

• • 

• 1 

, I 

• . • 

* . * * 

, 1 

• . • 

• f 

•WFIG* 

.•HTED 

•.•  AV. 

•♦•  TRA* 

.•NSFO 

•♦•RHED 

• f 

•ERGE* 

.•NCF 

•.• 

• . • • 

, • 

* . • 

• • 

1 nFIG* 

.•HTEO 

•.•  AV. 

•♦•  bha* 

.•TTAC 

•♦•HART 

• • 

• ISTA* 

.•NCE 

• . • 

• . 1 f 

, . 

• . * 

• f 

•PPOB* 

. •abil 

• . • ITY 

•♦•OF  M* 

♦•ISCL 

•♦•ASSl 

• f 

•TIOn* 

.•  OF 

•.•TRAl 

• « *N1NG* 

.•  OAT 

• . *A 

•/ 

OIVSIZ.PAGSIZ 
FETVC4 


•NCE  •» 
• DlV't 
•YA  D*. 
•FICA*. 


INTEGER 
INTEGER 
TPrNT=?7 
write  <G. HEAP) 

WRITE (6, mo ) ( PRC ( I. PRCKEY) .1=1.6). <CRI( I. CRIKEY) .1*1.13) 

in=l 

IE=1S 

*5  IFdF.GT.NOFFT?)  IE=N0FET2 

WRITE(6.inS)  (FFTvrPd)  ,I  = 1P.IE) 

IF  (IF.EO.NOFF.T2)GO  TO  10 
IB=IF*1 
IE=IF*15 
GO  TO  S 
10  CONTINUF 

WRTTF (6. 12S) 

TF(PPCKEY.E0.3.0R.PRCkEY.E0.4)WRITE(6.110)NOFET4 

TF(PRCKEY.E0.3.0«,PHCkEY.EQ.4)G0  to  Ifl 

iB=i 

iE=m 

1?  1F(IF.GT.  'J0FFT4)  IF=N0FET4 

TF(PwrKFY.LT,3) WHITE (6.120) (FET VC4 ( 1 ) . 1 =I B. IE ) 

IF  (PPrKEY.GE.is)  wHITE(6.115)  (FETVEC(I).  I = IB.IE) 
IFdE.EO,NUFFT4)G0  TO  18 
IB=IF.l 
IE=1F.16 
GO  TO  12 
m CONTINUF 

IF(CPIKFY.E0.1 )SFPMSH=OAriS(SEPMSK) 

1F(PRCKFY  .FO.DwRITt  (6.  l?0)StPMSR 
IFCPRCKEY  .F0.4)wRITF (6. 1 30) SFPMSR 
IF  (PWrKt'Y.GF.S)  WH1TF(6.14S)  SfPMSR 
TF(PRCKFY.LT.3)WRITF(6.140)SEPMSR 
IF (CRIKFY.FO. 1 )PATI0=SEPMSR/T0TMSR 
IFCCPIKFY.IJF.  1 )PAT10  = T0TmSR/SFPmSR 
IF  (CRIKFV.I.IF.  1 )WHI  IF  (6,  ISO)  TOTMSR.PATIO 
IF(CPIkFY.F0.1)WH1TF (6.1SS)T0TMSR.HATI0 
WRITE (6. 160) 


GENO 
&tNO^_ 
GENOfiO 
GENQOQAO 
GENOOOSO 
GENOGOGO 
Gf.NOOOTO 
6EN000B0 

siKssm 

GENOOllO 
GFN00120 
GENOOlSo 
GEN00140 
GEN00150 
GEN00160 
GENOOITO 
GENOOIBO 
GEN00190 
6|N00200 
6EN00210 
GEM00220 
GEN00230 
6EN0024Q 
GEN00250 
GEN00260 
GEN00270 
6EN002B0 
GEN00290 
GF.N00300 
GEN00310 
GEN00320 
GEN00330 
GEN00340 
GEN003S0 
GEN00360 
GEN00370 
6EN003B0 
GEN00390 
GEN00400 
6EN00410 
GEN00420 
GEN00430 
6EN00440 
GEN004SO 
GEN00460 
GEN00470 
GEN004B0 
GEN00490 
GENOOSOO 
6EN00510 
GEN00S20 
6FN00530 
GEN00540 
GFN00S50 
GEN00560 
GEN00570 
GENO05AO 
GFN00S90 
GFNOObOO 
GEN00610 
GEN 00620 
GEN00630 
GEN00640 
GFN00650 
GFN00660 
GFN00670 
GEN006R0 
GENOOGRO 
6FN00700 
GEN00710 
GEN00720 
GF.N00730 
GFN00740 
6FN007S0 
6FN00760 
GFN00770 
GFN00780 
GEN00790 


• • • • 


fILEt  OEN«PT 


(i.DWR 

0.4IMR 

r (PPCKEY.R6.5) 
tTTE(6«12%) 


aoo 


RE«0  INTE*<CI.ASS 
PRELIM, 


MEASURE  EOR  ALL  FEATURES  - COMPUTED  AND  SAVED  IN 


IR 


2*2 

AO<AnRESD*wRKRY*NWf ISTAT) 
FU.D60  TO  19 


?0 


c* 

c* 

c* 


NWb 

CALL  WR_ 
lF(IST*T,r 
NC»N0CLS2- 
TK«C 
DO  20  Tal.NC 
K»I*1 

no  20  JsK«N0CLS2 

IF*CRlKFY,E0.1>RAT|0«OIVTABJIK)/«RKRY(lj5) 
lF(CH!rEY,NE.l»HATlO«WRKRY(IK>/OIVTA8<lK) 
WRITF(6t210)CLSNA*MI)  ,CLSNAM(J)  j 

* WEIGHT (IK) «UIVTAS(1KI fWRKRY(IK) tRATlO 

!PCNT  = 1PCNT*1  ^ 

TFdPCNT.LT.PAGSIZJGO  TO  20 
IPCNTsl? 

IF(IK.rj.r>IVSlZ)GO  TO  20 
WRITE(<S»HE4D) 

WRITFif-.lGO) 

!F(CR!KFV.E0.1) WRITE(6*170) 
IF(CRIKKY.E'T.?)WR!TE(6»17S) 
1F(CRIKFV.EM.3)WRITE(A»180) 

!F (PPC^FY.LF.?) WRITE <6 ♦ 190 » 

IF  (PRC*fFY.E0.3)  wPITF(6«200» 

IF (PRCKfY.EO. 4) WRITE (6*200) 

IF  (RRCHEY.r,E.«j)  WRITE(6.205) 

write  (<‘,.125) 

rONTINUE 

IF(CMIWFY.nE.2>RETUHN 

GET  OIVERGEMCE  BACK  FOR  PLOTS 


GEn00970 

GEN009AO 

GEN00990 

6EN01000 


NO 

NO 

:N0 

;no 

•NO 

^NO 

NO 

:N0 


i060 

1070 

1080 


GEN01090 


GENO 

6EN0 

GENOl 

GENOl 

GENOl 

GENOl 


I! 


00 

10 

20 

30 

40 

50 


GEN01160 
GENOl 170 
6EN01180 
GEN01190 
GEN01200 
GEN01210 
GEN01220 
GENO 1230 
6ENOi|40 
GENOl 


13) 


00  30  I=1*DIVS1Z  „ ... 

WRKRY  ( 1 ) 3-l<^,*nL0G(WRKRY(  I)  ) 
r)IVTAR(I)=-l<S,*nLOG(OIVTABtI)  ) 

100  F0PMAtV^X*T3S* 'RF.SULTS  FOR  CHANNEL  SELECTION  ACTIVITY  USING:*/ 

* 1A*T40. *0PTIMIZATI0N  procedure  - **6A4/ 

* IX. T40, 'SEPARABILITY  MEASURE  - '.13A4) 
ins  FORMAT () X.T40. 'CHANNELS  CONSIDFREO  - • . 15 ( 12* • * • ) ) 
no  FORMAT  ( lX.T'XS* 'NO,  OF  LINEAR  COMBINATIONS 
HR  F0PMAT(1X.T3S**CHANNELS  EVALUATED 

* 14(12, •*•) ) 

120  F0RMAT(1X*T3S*'CHANNELS  SELECTED 

* I2*1S('*'*I2) ) 

1 FORmaT(/) 

130  F0RMAT(1X*T35*'SEPA«ABILITY  MEASURE  FOR  LINEAR  COMB* 

* F14.A) 

140  F0PMAT(1X,T3S, 'SEPARABILITY  MEASURE  FOR  SELECTED  CHANNELS 
14S*F0RMATn X.T3S, 'SEPARABILITY  MEASURE  FOR  EVALUATE  REQUEST 

1SO*FORMAT(1X*T3S, 'MINIMUM  SEP. MEASURE  (USING  ALL  CHANNELS) 

* E14.P/\X,T3S, 'RATIO' *T78* '*F14.B) 

1S^  format  ( IX, Tl'^. 'MAXIMUM  SEP, MEASURE  (USING  ALL  CHANNELS) 

‘ *F 14,8/1 X , T3S, 'RAT  10' ,T78, *-  *,F14,fl) 

140  F0PMAT(////  1 X,TSn* • IN7ERCLASS  SFPARABILITY  TABLE*  //) 

170  F0RMAT(1X,T73,» INTEHCLASS  0 1 VERGENCE • ) ^ , 

17S  F0RMAT()X,T4S,'INTFRCLASS  transformed  OIVEBGENCF*) 
joo  FOOMAT(1X,T4S,'INTFHCI  ASS  PHATTACMAHYYA  DISTANCE*)  _____ 

IRO  format ( IX, TP?, 'SUBCLASS  PA TR '* T4  1 ,' WF I6HT T58* 'SELECTED 

200*F0RMAT(  lx*,’V?2!l''SU^CLASS^PilR'lT4ll  'WEIGHT  • *T58*  'LINEAR  COMBINATIONGF.NOl|4  0 

?OS*FORMAT ( Ix*T?4^»5UHCLASs'*PAIR»It41 1 'WEIGHT ' *TSfl* 'EVALUATED  CHANNELSgInOJSOO 

* TWO, 'ALL  CHANNELS' ,TR9, 'RATIO' ) , , ^ 

210  format (20X, A4,7X,A4,4X,E8,3,T6n,Ol4,8»T7e*ni4,8,T96*O14,0)  6EN0I5B0 


GENO IS] 
CHANNELS'GENOISJ 


GEN01260 
GEN01270 
GEN01280 
GEN01290 
GEN01300 
GENO 1310 
6EN01320 
GEN01330 
GEN01340 
GENf.1350 
GEN01360 
GENO1370 
GENO 1380 
GENO 1390 
6EN01400 
GEN01410 
GFN01420 
6EN01430 
6FN01440 
GEN014S0 
GEN01460 
GF.N01470 
GFN01480 
6FN01490 
GENO 1500 
0 
0 

GfN0l530 


riLCi  GENRPT 


RETURN 

END 


6EN01590 

6EN0I600 


/ 


riLFi  otstat 


SU»R0UT  INf  GTSTAT  ICOVHTX  t mMTX  *S»C0VMT2* AVEMT2«S2* 

• VEC*ttMATtWRKf»Y*|WftK$Z> 

This  suhhoutine  selects  the  subsets  Of  the  statistical 
parameters  C0VMTX*AVEMTX  AND  S OEFlNtO  BY  VfC  OR  BMAT  ANO 
•STORES  the  subsets  INTO  C0VMT2t AVENT2*  ANO  S2  RESPECTIVELY, 

INCLUDE  COMHKl.LISI 
INCLUDE  C0HM»f7«Llst 

COMMON/ lNFOHH/NOCL$?«NOSUR2*NOEET2*VAWS??«TOTVT2,NQELn2 

• AVARj»,COVAH?,CLSl02.SUHNO|,SUBOS2iFLDSV2. 

• mvC2(30>  »SUBVC2(7l>  ,SUHPTH C 7S>  .CLSVCZTa 

• KEHRfStbO) «N0GRR«0HPNAM(60) «GRP0EX<61) « 

• GHHCHM 61)  .groups  (12A» 
COMMON/rSL/CEAC.TOTMSH.SfcPMSH.PRCXCY.CRIKEYtlNCEET* 

• INCygCno)  .icOUNT.SETwGT.EVALPMlOO)  .FFIVCAno) 
,MOFtT<..V»RS74»COHHAS»DfAflA»V6HSl*.PE5TVC(lO)  tOlVSIZ 


P.TOTVTZ.nOFLDZ. 

■ VERTX2. 

60)  « 


CSEnd 


• .GTaTKY.inHESO.ADRESR.AQBESf .AORSMl.AORSH 
INTERER  AOhPSO.AOhESP.AOHFSF.AORSmI.AOPSHZ.STATKY 
double  precision  CFAC. TOThSH.SEPmSR 

INTEGER  PMCmFY.CPIKEY.VEC.VARSZZ.VAPSZA 

OOUPLE  precision  COVMT2(VahSZ4.I) ,aVEHT2(NOFETA,1) , 

* S2(VAHSZa.I ) .RMAT (N0EET4.1 ) .WRKRYIl) tSUM 
dimension  COVMT*  (VARSZi'.MOCLS?)  t 

ftVEMTX(NOFET?«NOCLS?) , 

S<VAHS7?.N0CLS?)  fVECU) 


c* 


10 


PO 


10 


<40 

An 

AO 


ion 


IF  WITHOUT  MfPi  aCFHENT  OR  FX,  SEARCH  PROCEDURE*  SELECT  ELEMENTS 
determined  MY  »VEC'. 

00  TO  (S.5.PC.Z0.S.5) *PRCKEY 
CONTINUE 

DO  10  I«1.NDCLS2 
1X»0 

no  10  Jxl.NOFETA 
X«VEC(J) 

LOr»K«(K-l )/? 

AVFMT? ( J, 1 ) »AV£MTX (K, I ) 

DO  10  L«1.J 

fK»fK*1 

lUsVFC(L) *LOC 

r0VMT?( IK, 1 ) sCOVKTX ( IW,  I ) 

IFlCRIKFY.Nr.  1 )(,0  TO  10 

SPdK.DsSdw.I) 

rONT INUK 

RETURN 

DAVinON  OH  USER  INPUT  PHOCF.OURE,  MULTIPLY  B-MATRIX 

CONTINUE 

Twisl 

ITFSTs  Iwl  * NOFET2*NOFET* 
fEdvuKS7/2,OE.ITEST)60  TO  30 
WRITFIA,  100)  IWK'RS/ 

CALL  CMKRH 
CONTINUL 

no  PO  Tsl.NOCLSZ 
no  NO  Jsl.NOFFT* 

GIJMsf),  0 

00  «^0  K = J.:,orKT? 

«;UM  = SUM*ftVt  ''T*  (K,  I ) •MM*T  (J.K) 

AV^■MT?  ( I,  I ) 
rON'T  iNMk' 

CALL  TR‘iSFR<CnvMT*,COVMT?,HHKRVdWl)  ,PMAT) 

IE  <CMIKFy.t'J.  UCALL  THNSFR  (S.S?»wPKRY  (iWl ) ,0HAT) 

RETURN 

format  (•  NOT  ENOUGH  wORk  AREA  IN  GTGi  .vT  — IWRKSZst.IS) 

FNO 


5M( 

COM( 

COM( 
COMOOOSO 
COM00060 
GTSOOIZO 
GTfooaSQ 
6TS002A0 

gtsooHq 

GTS0026Q 
GTS00270 
6TS00^b| 

GTS00310 

GTS003A0 

GTS00350 

6TS00360 

GTS00370 

GTsoosao 

GTS003R0 

GTS00400 

GTSOOAlO 

GTS00420 

GTS00430 

GTS00440 

GTS00450 

GTS00440 

6TS00470 

6TS00460 

GTS004RO 

GTSOOSOO 

GTSOOSIO 

GTS00520 

GTSOOS30 

GTS00540 

6T5005S0 

6TS00560 

GTS00S70 

6TS00580 

GTS00590 

GTS00600 

GTS00610 

6TS00620 

GTS00630 

GTS00640 

GTS006S0 

GTSO0660 

GTS00670 

GTS00680 

GTS006R0 


FILFI  HTl 


C* 


NTl  - HATFtll  B IS  STORED  IN  SYMMETRIC  NOTATION  AND  SINGLE  RRE 


•iS 


f <«T1  (A.BtCtMfN) 

ECISfON  A(M,N}«CIH,N).SUM 

IS*UoREO  IN  symmetric  NOTATION 

no  ftO 

no  NO  JjaitN 
00  K*c«l  »'• 

If  (KK.G^-.JJ)  * JJ 

If  (RH.LT.JJ)  ♦ RK 

SUM  ■ SUM  • A(tI.KK)«RUK) 
rni»JJ)«suK 
pf Turn 


SURROUTJN 
nOllPLE  Rm 
OImEnSION 

MATI$1X  M 


PILFS  MT? 


C* 

C* 

c* 

c* 


SUPROUTINE  TO  form  PRODUCT  OF  MATRICES  A*B  AND  STORE  IN  C. 

MT2  - Matrix  a IS  stored  in  symmetric  notation 

subroutine  MT?(A«B»C«MtN) 

DOUBLE  PRECISION  A < I » tB (M»N) ,C (M.N) »SUM1 

no  Ro  ii=i»M 

no  RO  UJ=I»N 
SUMlxO.O 
DO  ns  IJ=1.M 

TFdJ.OP.Il)  IKsIJ*(IJ-l)/2*Il 
IF(IJ.LT.II) IKsII*(II-1)/2*IJ 
ns  SUMlrSOMl  ♦ A(IK)*8(1J»JJ) 

RO  r(ii.jj)=suMi 

return 

END 


fC^ 


PRFt  MTS 


c*  matricfs  a ano/oiv  a may  be  stored  in  symmetric  notation 

C*  LsM  ir  A IS  SYMMETRIC  N=M  IF  B IS  SYMMETRIC 

subroutine  MT3(A,B»C.L*M»N, ISYMA*ISYMB) 

DOUBLE  PRECISION  A ( 1 ) »6  ( 1 ) « C (L  *Nji  tSUM 
DO  70  II=1»L 

no  70  jjsi,N 

SUMsO.O 
no  6S  KKal»H 
IFdSYMA.tO.DGO  TO  61 
IKsL*(kk-1)  ♦ II 
GO  TO  Oi' 

*,]  IF(KK.r,j:  .II  ) IK  = KK<»(KK-n/B  . n 
IF(KK.LT.II) IK=II»(Il-l)/2  ♦ KK 
6?  IFdGYMa.EO.lIRO  TO  63 
JK=M*(jj-n  ♦ KK 
GO  TO  6S 

63  TF(KK.Gr.JJ)  JK  = KK*(KK-U/?  ♦ JJ 
TF(KK.LT.JvJ)  JK=JJ*(JJ-l>/2  ♦ KK 
6^  SIJM  = SUM  ♦ «(lK)*rt(JK) 

70  CdI*JJ)=SUM 
RETURN 
END 


/•y 


FILF:  MT% 


C» 

C« 

C* 

C* 

C* 

C* 

C* 


0(1 

os; 


SUPHOUTINF.  MT4UiBfC.LtM»NtISYM) 

matrix  a Cam  be  stored  full  or  in  symmetric  notation 


ISYM=1 

ISYMaO 


IF  A IS  SYMMETRIC 
IF  A IS  FULL 


DOUBLE  PRECISION  A (1 ) *8 (M,N) «C (LtN) «SUM 

no  iiaUL 
no  os  jjsi,N 

SUMaO.O 

no  on  iJsi.M 

IFdSYv.EU.I  )G0  TO  flS 
1K=L*(TJ-1)  ♦ II 
no  TO  Qo 

IFdJ.PE.II)  IK  = IJ*(IJ-1»/?  ♦ II 
IFdJ.LT.II)  IK  = II*<Il-l)/2  ♦ IJ 
SUM  s SUM  ♦ A<1K)*8(IJ.JJ) 
CdI.JJ)=SUM 
RETURN 
FNn 


//‘I 


FILFJ  PLOT 


SUPPOUTINE  PLOT{X*Y«NOXiHAXX«ILABLXf ILA6LY<ICn0C*I0PT> 


ri  — iconE  AND  lOPT  are  SET  TO  0»  AND  ILABX.ILABY 
C*  WRITE  STATEMENTS  WERE  ADDED  FOR  LABELING. 


C* 

!* 

c* 

ES 


THIS  SUBHOUTINP  WAS  WRITTEN  BY  J.K.DALY  OF  TRW  FOR  THE  ASTEP 
PROGRAM.  IT  WAS  MODIFIED  SLIGHTLY  FOR  USE  IN  THIS  PROGRAM  BY 
R.  MINTER 


ARE  BLANK. 


CO 

INPUT  VARI) 

CO 

X 

CO 

Y 

CO 

NOX 

CO 

MAXX 

CO 

ILABLX 

CO 

ILAHLY 

CO 

ICODE 

CO 

CO 

CO 

CO 

I OPT 

INTEPNAL  V 

CO 

EMDX 

CO 

CO 

FMTARY 

CO 

I 

CO 

CO 

INDEX 

CO 

CO 

INITLN 

CO 

INLIM 

ro 

J 

CO 

K 

CO 

CO 

L ABrtOX 

CO 

L ASTLN 

CO 

M 

CO 

MHDKIZ 

CO 

mlnct 

CO 

NOX 

CO 

NOXPT 

CO 

CD 

NOYPT 

CD 

CO 

SCLARY 

cn 

CO 

WIEL  AR 

CO 

CO 

CO 

XLNVLII 

CO 

CO 

CO 

XSCLAR 

CO 

YLNVLU 

cn 

CO  * 

• • • • 

PLOOOOIO 
•*  PL000020 
PL000030 
PL000040 
PLOOOOSO 
PL000060 
PL000070 
PLOOOOAO 
PL000090 
PLOOOlOO 
••♦PLOOOilO 
PLO00||0 
PL000130 
PL000140 
PL000150 

- array  containing  X COORDINATES  (TYPE  REAL)  £!-92Slt2 

- ARRAY  CONTAINING  Y COORDINATES  (TYPE  REAL)  PLOOOlTO 

- NO,  Of  X COORDINATES  INPUT  (MAX.  39)  PL000180 

- MAXIMUM  VALUE  OF  POINT  ON  SCALE  TO  BE  INPUT  /INTEGER) PL000190 

- LABLE  of  the  X-AXiS  (MAX.  OF  7B  CHARACTERS  ALLOWED)  PL000200 

- LABLE  OF  THE  Y-AXIS  (MAX.  OF  7ft  CHARACTERS  ALLOWED) 

- 1 = PUN  IS  MADE  ON  TSS. INVALID  12-77 


programmer  - J.K.  DALY 

DATF  - FEBRUARY,  1973  ^ 

MODIFIEO  FOR  I=»M  T70-14B  R HANSEN, C HORTON  DEC,  1977 


PLOgO^^g 


0 = RUN  IS  made  on  noft 

- 0 = 45  DEGREE  ANGLE  LI  Jl  ..  . 

1 = NO  45  DEG  ANGLE  LINE, INVALID  12-77 


■GREE  angle  line  TO  BE  DRAWN  ON  PLOT 


PLOOOt 
PL000230 
PL000240 
PL000250 
PL000260 
PL000270 
PLO002B0 
PL000290 
PL000300 

PL000310 

OF  WORDS  OF  FMTARY  TO  BE  WRITTEN  (TSS*! 1 ,PL000320 

PL000330 
PL000340 
PL000350 
PL000360 
PL000370 
PLO003R0 
PL000390 
PL0004CO 
PL000410 
PL000420 
PL000430 
PL000440 
PL000450 
PLO00A60 
PL000470 
PLO00480 
PL000490 
PL000500 
PL000510 
PLO(>0520 
PL000530 


- WHICH  WORD  OF  THE  FORMAT  ARRAY (FMTARY)  TO  START 

LOADING  THE  LABELS.  ^ ^ 

- ARRAY  TO  BE  BUILT  FOR  EACH  LINF  OF  THE  PLOT 

- INDEX  FOR  inner  LOOP  FOR  DETERMINING  THE  LOCATION 
OF  THE  POINT  ON  THE_X-AXIS 

- MAXIMUM  NO 
1 10R=15> 

- INITIAL  LINE  TO  BEGIN  PRINTING  THE  LABELS 

- NUMHER  of  POINTS  TO  FALL  IN  SAME  PLACE  ON  PLOT.^ 

- INDEX  FOR  LOOP  TO  FIND  NEXT  HIGHEST  Y-COORDINATE. 

- INDEX  FOR  OUTER  LOOP  BUILDING  AND  PRINTING  EACH 

line  of  plot. 

- INDEX  FOR  LABAPY 

- LAST  LINE  TO  PRINT  LABEL  ON  PLOT 

- INDEX  OE  SCLARY 

- NO.  OF  CHARACTERS/PLOT 

- NO,  OF  LINES/PLOT 

- INDEX  TO  *WICLA8» 

- NO.  OF  POINTS  TO  FALL  BETWEEN  LABELED  POINTS 

- NO.^OF^POINTS  TO  FALL  BETWEEN  LABELED  POINTS 
C)  Y A X T 5 

- ARRAY  CONTAINING  POINTS  TO  BE  PRINTED  AS  LABE;_S 

ON  T^-if.  X-  ANO  Y-AXiS  , ^ 


DEPENDING  ON  THE  LINE  NO,  DETERMINES  WHICH  LABLE 
jwfLLPFPWlNTFDp  - 

VALUf  OF  FACh  point  on  THE  X-AXIS.  USED  TO  CALCUL ATEPL000540 
EACH  POINT  OF  XSCLAR  (X  SCALE  ARRAY)  IN  SUBROUTINE  PLOOOSSO 
SCALF.  PL000560 

AETIJAL  VAliJE  OF  EACH  POINT  ON  X-AXIS  (TYPE  REAL)  PL000570 


POINT  OF  YSCLAR  (Y  SCAL^  ARRAY) 
c include  COM^kh.LIST 

C INCLUDE  C0MmK7,LIST  , ^ 

COMMON/GLOB aL/hEaD( Mi ,MAPTAP,nATAPE,SAVrAP,RME IuE.BMKEY,^ 

* HI  Sr IL.H1SKEY.TPFORH,ERIPTP,ERPKEY,MaPUNT,NOFILF, 

* nRii"AO,nHM*bS,PAGSIZ,DATF  IL  ,'-'TAF!L,ASAV,  ASAVFL 

* .nhstun.nhsth.sctpuniMapfil 

* .DOTIInT.DOTFTI  ,MChPA5,TPNSFL,BMTRFL,HlSTFL,PCHUNT, 

* CRDUHT ,pRTUNT,RAM)IO 

rOMMON/FSL/CFAC,TOrMSR,5EPMSR,PRCKEY,CRIKEY. INCFET, 

* INCVEC  ( ^0)  , ICODNT  .SHwGT  ,F  VALHF  ( ion)  .FFTVC4  no) 

* .►'OFFTa , VA«S7a,CORhAS,OTaba,WGHS14,BE5TVC ( 10) ,DIVSI7 

* ,STAlf\Y  . ADHESDt  AORESP,  ADRESP  , AORSHl  , ADRSH2 
INTEGER  AORFSD.  AORi'SH.  ADRF  SF  . ADRSHl , A0RSH2  , S T ATKY 
INTEGER  HCDy.PCUX .HCOHL^,MCDSTR 
DOUBLE  PREOSION  CF  AC  , T UTMSR  , SF.PmSR 


CSENO 

c 


DIMENSION 


FMTARY (23) 


PL000590 

PL000600 

PLO0C610 

PL000620 

PL000630 

PLO0O640 

PLO006S0 

PL000660 

PL000670 

PLOOOfeftO 

PLOnONRO 

PL000700 

PL000710 

PL000720 

PL000730 

PL000740 

PL000750 

PLU007G0 

PL000770 

RL000780 

PL000790 


on  on  001  on  no  on  non  on  orto 


filf:  plot 


c 

c 


RFAL  YSCLAR(ST) *XSCLAR(8S) 

nOMWLE  PRECISION  XJNOX) »Y<NOX) 

PEAL  SrLA.»Y(*»> 

TNTFOFP  CRIKEY. PRCKEY 

tNTEOER  LAB*RY(A0) .LABNOX.WICLAB(10» .FMOX 
INTEGER  ILAPLX(20)»  ILABLY <20) .FMfARY.ASTRIC.O 

LOGICAL*!  FRTA(S>2J.  LTEST  (4»  .LSTAR.LOGI 

OATA  L0G1//FI/.  LBLANK/24n/,LSTAR/Z5C/ 

OATA  FMTAkY/?3*4H  / . ASTR 1C/4H****/ . IBL ANK/AM  / 

HATA  IP0IM/4H  1/ 

data  RCnnLK/74n/,BCUSTR/ZSC/.HCD9/ZF9/f8CUX/ZE7/ 

DATA  wICLAB  /SS.S4.52. 50.49,42. 41 .40. 39. 3«/ 

F0U1V«IENCE  (FMTA(l)  .FMTARY(l) ) , (ITEST.LTESTd) ) 
blank  K AMD  Y LABEL^i 

no  mo  T=  l.?fl 

IL4BLXn>*lRLANK 
100  ILAfiLYIIlalRLANK 

» FIND  MAXX 
MAXX=l 
ABAXsO. 

IF(CRIKEY.ED.3»G0  to  900 
IKCTsO 

COUNT  NU«BPR  OF  Xtt)  GREATtH  THAN  700.  SET  AMAX  * LARGEST  X(I) 

9FT  MAXXsTnO  unless  MOHE  than  1/5  of  ELEMS  GRTR  70, then  MAXX*1400 
no  BOO  1=1. Nox 
TF(X(I).GT.700) IKCT=1KCT*1 
BOO  rONTlMllt-- 
MAXXs  700 

TF (FLOAT ( mCT ) /FLOAT (NO*)  .6T,  .2)HAXX=1400 

900  rONTiNUF 

WRITF  MFSSAGF  'SEPARABILITY  TO  HE  GAINED  MAP* 

CALI  ‘^FTM9ft(66.2.('4) 

WBl  TF  (ft.  m9S) 

IftOS  format (SO*. 'SEPAHABILITY-TO-BF-GAINFO  HAP») 

blank  LAHAMY 

no  1000  ii  = i.4fi 
LABARY(II)  = IfjLANK 
1000  rOMTiNUF 

BLANK  FMTARY 

nn  mni  11  = 1,21 

moi  FMlABYtll)  = IRLANK 

c;TORE  Y-  ANt'  Y-A*1S  LAHFLS  INTO  LAHEL  ARRAY  (LABAHY ) 


no 

in? 

n II 

= 1 . 

?'i 

IF 

(IL 

ahly 

(II 

) .FO. 

n 

) 

GO 

TO 

1,  ABAPV 

(ID 

s 

ILAHL 

Y 

(I 

1 ) 

TO 

IF 

(IL 

AHL* 

(II 

) .F(.. 

0 

) 

GO 

1 A«ARY 

(11* 

?n) 

= 11. 

A 

ML 

* ( ] 

[ 1 ) 

m?0  '■ONTIMUF 

• • • « SFT 

V iw  I 

LAPMOX 

= 1 

" = 7 

mlncT 

= 

khoqi / 

MOtPT 

hOyPT 

= H 

NOS  PAT. 

TNITI  N 

= SS 

LASTL^' 

NOX 

= 1 

FMOX 

•= 

INPFX  = 

CALI  'iCAi  T<)  FC'P  SCALE  FOR  PLOT 
lOftO 


PLOOOGOO 

PLOQ0810 

PLO00B20 

PL000830 

PLO00B40 

PLO00B50 

PLO00H60 

PL000870 

PL000880 

PL000890 

PL000900 

PL0009iO 

PL000920 

PL000930 

PL000960 
PL000970 
PL0009BO 
PL000990 
PLOOIOOO 
PLOOlOlO 
PL001020 
PL001030 
PL001040 
PL001050 
PL001060 
PL001070 
PL001080 
PL001090 
PLOOllOO 
PLOOlllO 
PL00112C 
PL001130 
PLOOl 140 
PLOOllSO 
PLOOl 160 
PL001170 
PLOOllflO 
PL001190 
PL001200 
PL001210 
PL001220 
PL001230 
PL001240 
PL001250 
PLOOlPftO 
PL001270 
PLO012B0 
PLO01290 
PL001300 
PL001310 
PL001320 
PL001330 
PL001340 
PL001350 
PL001360 
PL001370 
PLO013B0 
PL001390 
PL001400 
PLO01410 
PL001420 
PL001430 
PL001440 
PLD01450 
PL(I014''0 
PLOOl 4 70 
PLOOmoO 
PL001490 
PLnoisoo 
PI  on  IS  10 
PLO01520 
PLonis.io 
PIU01S40 
PL  UOISSO 
PLOOlS(iO 
PL001570 
PLOOISHO 


r>o  o ooo  r»r>r>  n n n n r»  o o or»r»  r»r»o 


MLF:  plot 


CALL  SCALF(PAXX,HLNCTtlNCRF.YSCLARiXSCLARtSCLARY»XLNVLU»YLNVLU. 
• MHnalZ«NOXPTfNOYPT» 

XLNVUJ  » XLNVLU/Z.O 
YLNVLO  « YLNVLU/2.0 
lOPO  CONTINUE 


FTNO  Y COORDINATE 

no  1480  II4A0  s ItHLNCT 
K « MLNCT  - 11480  ♦ I 
no  1180  J*1»N0X 
YY  = Y(J) 

1F(YY.6T.YSCLAR(K) )60  TO  1180 
IF(YY.LF.YSCLAR(K-1) )60  TO  1180 
TF  (YY.GT.FLOAT(HAXX) ) GO  TO  1180 
lino  CONTINUF 


• • • • Y coordinate  found.  NOW  FIND  POS.  OF  X COOO. 


no  1160 

1 3 MHOPl 


1160  = l.NHORIZ 


11160  = 

»I7  - 11160  ♦ 1 
CHECK  FOR  X VALUE  IN  RANGE 
XX  — X ( «J) 

IF  7xx.6T.XRCLAR(1))  go  TO  1160 
IF(XX,LE.XSCLAR(I-1) ) 60  TO  1160 
TF  (XX.GT.FLOATTMAXxn  60  TO  1180 
MOVF  TTH  CHAR  TO  ITE8T,  RIGHT  JUSTIFIED*  0 FILLED 
ITPST  3 0 

LTFST(4)  s FMTA(I) 

ChFCK  for  blank  or  star  implying  no  PREVIOUS  OCCURANCES 

IF  (ITEST  .FO.  BCOBLK  .or.  ITEST  .EO.  BCOSTR)  go  to  1140 
CHECK  FOR  X implying  MAXIMUM  COUNT  ALREADY  REACHED 
IF  (ITEST  .E(J.  BCnX)  GO  TO  1180 
ADD  1 TO  COUNT.  IF  PORE  THAN  9 OC 
TTEST  3 ITEST  ♦ 1 
IF  (ITFST  .6T.  RC09)  ITEST  3PCOX 
CTORE  updated  COUNT  HACK  IN  FMT  ARRAY 
FMTA(I)  = LTEST(4> 

DO  TO  1180 

BLANK  OP  STAR,  STORE  1 FOR  FIRST  OCCURANCE 
1140  FMTA(I)  3 LOGI 
DO  TO  1180 
UNO  CONTINUE 
1180  CONTINUE 


kCURANCES*  CHG  COUNT  TO  X 


RUILD  4S  DEGREE  ANGLE  LINE  OF  PLOT 
TF  («on(K,2) .FO.O)  60  TO  1220 
NOSPAC  = NOSPAC  - 1 
LTFST(4)  3 FmTA(NOSPAC) 

IF  (ITEST  ,r;F.  LBLANK)  GO  TO  12?0 
EMTA(NOSPAC)  = LSTAR 


EFT  IIP  LAPFL 
l??n  CONTINUE 

DETERMINE  whether  OR  NOT  LABEL  IS  PRINTED 
IF  (K.LT.LaSTLN)  go  to  1340 
IF  (K.DT.INITLN)  GO  TO  1340 
IF  (K.NE.WICl AB(NDX) ) GO  TO  1340 
IF  (K.FO.Sii.OR.K.ECl.AO)  GO  TO  1320 

MOVE  LAPARY  TO  FMTAHY 
IJ  = FMOX  ♦ !S 

IF  (ROn(K.2)  .EO.  0)  IJ  =FMOX  ♦ S 
no  1240  lIsFMDX.lJ 
FMTARY(II)  = LABARY(LA8N0X) 

I ABND*  3 LAHnOX  ♦ 1 
1?40  CONTINUE 

NOX  3 NOX  ♦ 1 
GO  TO  1340 
1370  CONTINUE 

FMTAPY (F“OX*3) =1HLANK 
NOX  3 *ipx  * 1 
1340  CONTINUE 

IF  (K.FU. MLNCT)  GO  TO  1380 
IF  (Mon(K*;,H) .EU.O)  60  TO  1380 
WHITF  (6. IbSO ) FMT ARY 
DO  TO  1440 


PL001590 

PLQ01600 

PL001610 

PL001620 

PL001630 

PL001640 

PL0016SO 

PLO0I660 

PL001670 

PL001680 


PLOO] 

PLOO 

PLOO 

PLOOi 


690 

700 

710 

720 


PL001730 
PL001740 
PLOOI 750 
PL001760 
PL001770 
PLOOI 780 
PL001790 
PL001800 
PL001810 
PL001820 
PL001830 
PL001840 
PL001850 
PL001860 
PL001B70 
PL001B80 
PL001890 
PL001900 
PL001910 
PL001920 
PL001930 
PLO01940 
PL001950 
PLOO 1960 
PL001970 
PL001980 
PL001990 
PL002000 
PL002010 
PL002020 
PL002030 
PL002040 
PIO020S0 
PL002C60 
PL002070 
PL002080 
PL002090 
PL002100 
PL0021 10 
PL002120 
PL002130 
PL002140 
PL002150 
PL002160 
PL002170 
PL002i80 
PLU02190 
PL002200 
PLOO2210 
PL002220 
PL002230 
PLO02240 
PL0022bO 
PL002260 
PL002270 
PLO02280 
PL002290 
PL002300 
PL002310 
PL002320 
PL002330 
(-‘1002340 
PLO023S0 
PLO02360 
PU)02370 


uuu 


FILF*  PLOT 


15^0 

13«0 


FOPMAT  (Irt 
CONTINUE 


»22X,lM*t23AA) 


PRINT  PLOT  FOR  llOS 

IF  (m.le.1)  GO  TO  uao 

IF  IK.FO.MLNCn  WRITE  <6* 1660) FMTARY 
1660  FO«»MAT(lM  t?lX.2H  •.23A4) 

IF  (K.FO.MLNCT)  GO  TO  1440 
WRITE  (6tl540)SCLARY(M) tFMTARY 
1540  FORMATdM  tl4X.E7,2»2M  **23A4) 

M * M - 1 
1440  CONTINUE 


WRITE 

no 


1460 


1710 

17?0 

1030 

1730 

1740 

103S 

1460 


X AND  Y LABELS  AS  SELECTED 
_ 1460  11460=1»1NOEX 
FMTARY  < 1 146n)aIBLANK 
CONTINUE 

IF(K.NF,40)GO  TO  1030 

IF (PRCKf Y.E0.3  ,OR.  PRCKEY.EQ.4)WRITE{6tl710) 
F0PMAT(1H*.M.1NEAR*) 

1F(PRCkEY.EQ.I  .or.  PRCKEY.EQ.2)WR1TE(6.1720) 
FORMAT ( IH*. t selected* ) 

IFCK.NF.a^IGO  TO  1035 
IF(PPC*<EY.E0.3  .OR.  PRCFEY.EO.4) 
F0RM4T(1H*.*C0M8.*) 

IF(PRCYEY.E0.1  .OR.  PRCKEY.EQ.2) 
format (IM*. tCHANNELS* ) 

continue 

CONTINUE 


WRITE(6tl730) 

WRITE(6»1740) 


c* 


AND  labels 


) ♦1H*/15X.E7,2»3X»7(5X»E7.2) ) 


• * PRINT  X-AXIS  LINE 

• * non  SIZP  PLOT 
WRITE  (G.lSnO) tSCLARY(L) .L=1.8) 

1S«0  FORMATOH  .??x,7(12H*  * • * • * 

WRITE (6, 1750) 

17*10  format  (/60X  . *ALL  CHANNELS*) 

TF(CRlKKY.e0.3)>*RlTE(6.16<»0)  . 

1600  foomat(/5ox.  *interclass  bhattacharyya  distance*) 

IF  (CR I •'EY. ME.  3)  WRITE  (6.1700) 

1700  F0RMAT(/55X»  *PAIRWISE  DIVERGENCE*) 
return 
END 


PLO023R0 
PL002390 
PL002400 
PL002410 
PL002420 
PL002430 
PL002440 
PL002450 
PL002460 
PL002470 
PL002480 
PL002490 
PL002500 
PL002510 
PL002520 
PL002530 
PL002540 
PL002550 
PL002560 
PL002570 
PL002580 
PL002590 
PL002600 
PLO0261Q 
PLO02620 
PL002630 
PL002640 
PL002650 
PL002660 
PL002670 
PL 

PL( 

PC002700 
PL002710 
PL002720 
PL002730 
PL002740 
PL002750 
PL002760 
PL002770 
PL002780 
PL002790 
PL002800 


W Si  IS 
0U4 tftV 


FILFJ  PRELIM 


SURROUTINE  PPELlHCCOVMTXt AVEMTXiOIVTABtWElGHTiS* 

• WRKRYtWRKSlZ) 

THIS  SUBROUTINE  PERFORMS  SOME  OF  THE  PRELIMANARY  TASKS  FOR 
FEaTURE  SFLPCTION.  THE  INTERCLASS  MEASURES  USING  ALL  FEATURES 
ARE  CO^PUTEO  AND  STOREC  ON  A SCRATCH  FILE  FOR  LATER  PRINTING, 

IN  aOQITION.  THIS  SUBROUTINE  COMPUTES  THE  •§•  MATRICES  USED  IN  PRfOOOf 

COMPUTING  >*EI6hTED  AVERAGE  DIVERGENCE  IF  CRIKEYal,  IF  WEIGHTS  PREOOOS 

ARE  TO  HE  SET  BY  DEFAULT*  THE  SUBROUTINE  ALSO  PERFORMS  THIS  TASK,  PREOOH 

IMPLICIT  INTE6ER<A“Z) 

INCLUDE  C0MHK1,LIST 
INCLUDE  COMok7,LIST 

COMMON/INFORM/NOCLS2»NOSUR?,NOFET2,VaPSZ?.TOTVT?tNOFLOZ* 

• AVAR2,C0VAR?,CLSI02,SUBN0?.SUPDS2»FL0SV2.VERTX2, 

• FFTVC2(30) ,SIIHVC2(7S) ,SOBPTH(7S) ,CLSVC2(60) • 

• KEPPTS(f.O>  ,N06RP.GHPNAM(60)  .GRPOEX  (61)  * 

• GRPCHK (61) «GR0UP5(124) 
COMMON/FSL/CFAC.TOTMSR.SfPHSR,PRCKEY,CRlKEY, INCFET* 

• INCVEC  (■»())  , ICOUNTvSETwGT.EVALBF  (inO)  »FFTVCA(30) 

• ,NOFET4.VARSZA.CORBAS,OTAB4,W6HS1A.PESTVC(10) tOiVSIZ 

• ,STaTkY,AORESO»  ADhESP, ADRESF,AORSh1,AOPSM2 
INTEGER  AnwFSD. AORESP . AORFSF * AORSHl , A0RSH2,STATKY 
DOUBLE  PRECISION  CFAC,TOTMSR.SEPhSR 

) 

COMMON/hfSTkN/  KPPPTS(60>,  IPRIOR,  KBFST,  NCPASS 
REAL  COVMTX (VANSZ2.NOCLS?) , A VFMTX (N0FET2*N0CLS2) » 

• WEIGHT (PIVSIZ) ♦ S(VARSZ2.NOCLS2) 

PFAL  T no)  . ApPwGT  (7BO)  ,ANUHRX 
DOUBLE  PRECISION  D I VT AB (01 VSIZ ) *OUM 
DOUBLE  HRECISION  wRKRYd) 

REAL  TW(60) 
anumpx  = 0. 

DO  1 I=1.N0CLS2 

ANUMPX  a ANUMPX  ♦ F LOAT ( KPPPTS ( 1 ) ) 

K = n 

NC  = NDCLS2  - 1 
DO  2 1=1, NC 
IK  * I ♦ 1 
DO  2 II  = IK.N0CLS2 
K = K ♦ 1 

APRWGT (K ) =PLPAT (KPPPTS ( I ) *KPPPTS( 1 1 ) ) / ( ANUMPX«*2) 

APR«tGT(K)=SQHT(ARRWGT(K)  ) 

IFdPRIOR. 0)  WRI  IF  (6tRR0) 

format (1H1.«  APRIOHI  WEIGHT  MULTIPLIERS  AND  TOTAL  NO  PIXELS') 
IF(IPRIOB.NF.O)  WPITK(6,1000)  ( APRWGT ( I ), I * 1 ,01 VSI Z )♦ ANUMPX 
) format ( ) 

TF  (SFTviiGT.FD.a)  GO  TO  6 
DO  S 1 = 1 ,I)IVSIZ 
RFIGHT(I)  = 1.0 
IF  ( IPRIOR. RO.O)  GO  TO  9 
00  7 1=) ,DI7SIZ 

WEIGHT (I)  = WE1GHT(I)*APRW6T(I) 

CONTINUE 

SET  IPART  SO  PARTIALS  WILL  NOT  BE  COMPUTED. 

TPaRT=-l 
IFULL=1 

GO  T0(10,70.80,90) fCPIKEY 

criteria  - weiGHTFO  AVERAGE.  DIVERGENCE 
—COMPUTE  INTERCLASS  DIVERGENCES 
— SFT  wfighTS.IF  SETw6T=0 

— COkPUTF  s-matricfs 

— CD-^PUTE  WFIGHIEO  AVERAGE  DIVERGENCE  FOR  ALL  FEATURES 

1 CALL  0IVtf'G(CDVMrx.VARSZ2,AVFMTX,0IVTAB.N0CLS2»N0FET2, 

• WHKRY.WRKSIZ) 

TF(SFTW6T.NF.0)G0  TO  2S 
no  20  K=l,olVSTZ 

WFIGhKc)  = DFXP(-DI  VTAri  (K) /16. ) 

IF(IPRIOR.NF.O)  WEIGHI(K)  = WEI6HT(K)»APRWGT(K) 

COMPUTE  S-maTRICES 
; CONTINUE 

DO  30  j=i,Nnn.S2 

00  30  I=1.VARS72 

1 s(T..))=o,n 
NC=N0CI.S2-1 
DO  60  N=1.N0CLS2 


IK.N0CLS2 


GO  TO 


J><5' 

//S" 


• •• 


FILFt  PRELIM 


C* 


C* 


C* 

C* 

C* 

C* 


C* 

C» 

C* 


C* 


SELECT  ALL  WEIGHTS  FOR  CLASS  N 

KT-0  . 

K«0 

MN«0 

00  35  J-l.NC 

i?l*3§'l«IJtN0CLS2 

K>K«{ 

IF (J.NE.N.AN0*I.NE.N)60  TO  3S 
KT»KT*1 

TW(KT)«WE1GHT(K) 

35  CONTINUE 

00  sn  M«1»N0CLS2 
IF(M,E0.N)60  TO  50 
MN«MN*1 

00  40  I«1,N0FET2 
40  Tn»sAVEMTX(I.NJ-AVEMTX(I.M) 
jsO 

00  45  !»1,N0FET2 
00  45  K»1.I 
J«J»1 

45  S( J*N)sS(J*N)«TW(MN)*(COVMTX(J»M) «T(I)*T(K) ) 

50  CONTINUE 
60  CONTINUE 

COMPUTE  CFaC 
CF4C»0 

00  65  Tsl.OIVSIZ 
45  CFAC  = CFAC  ♦ WEIGHTU) 

CFAC=\./CFAC 

COMPUTE  AVEPAGE  weighted  DIVERGENCE 

CALL  AVEOIV (TOTMSR»COVMTX,S*OUM,OUM,WRKRYtWRKSIZ» 

• lPARTtOUM*DUM,IFULL> 

TOTMSHsDABS (TOTMSR) 

GO  TO  35 

CRITERIA  - WEIGHTED  AVERAGE  TRANSFORMED  DIVERGENCE 


70  CALL  TRNOIV(TOTMSRfCOVMTX»AVEMTXtDUMtOUM»WEI6HTtDIVTABt 

• WRKRY*WRKSIZ*IPARTtOUM,DUM*IFULL) 

GO  TO  35 

CRITERIA  - PHATTACHARYYA  DISTANCE 

50  CALL  BHTCHH(TOTMSR.COVMTX,AVEMTX»WEIGHT,DIVTA0tDUMtDUM» 

* W«KRYtWRKSIZ*IPARTtDUM,OUM, IFULD 
SAVE  IMTERCLASS  WEIGHTS  ON  DRUM 

55  IQsDlVSIZ*2 

CALL  RWRITE (ADHESO.DIVTAB, lOtlSTAT) 

56  IFdSTAT.EQ.DGO  TO  66 
90  RETURN 

END 


PREOOBIO 
PREOOafO 
PRE00830 
PRE00840 
PRE 00850 
PRE00860 
PMEOOaTO 
PRE00880 
PRE00890 
PRE00900 
PRE00910 
PRE00920 
PRE0093Q 
PRE00940 
PRE00950 
PRE0Q960 
PRE00970 
PRE00980 
PRE00990 
PREOIOOO 
PREOIOIO 
PRE01020 
PREOI030 
PRE01040 
PRE 01050 
PRE01060 
PRE01070 
PRE01080 
PREOIOOO 
PREOllOO 
PREOli: 
PREOI ■ 


)ino 

>1120 


■811i 


130 
..  _J40 

PPE01150 
PREOI 160 
PRE01170 
PPE01180 
PRE01190 
PRE01200 
PRE01210 
PRE01220 
PRE01230 
PREOi240 
PR|o1250 
PREOI 260 
PRE01270 
PRE01280 
PRE0i290 
PRE01300 
PRE01310 
PRE01320 
PRE01330 
PRE01340 


r>r»non  onnoo 


FILE*  PRTFLO 


CSENO 


SUPROUTINE  P«TFLO(COVMTX.*VEHTX.FLOMTX»VERTEX» 
• CLSNXM.SUBNAM) 

IMPLICIT  INTEGER  (A-M.O-Z) 

PRINT  TRAINING  FIELDS  AND  CLASS  STATISTICS 


INCLUDE  COMPKItLIST 

DATA  LPWN/»rH<*/,RPRN/») */ 

INCLUDF  C0M-1K6.LIST 

COMMON/ IKF0»H/NbcLSZ.N0SUP2.N0FET2tVARSZ?;T0TyT2»N0FL0?. 

AVAR2,COVAH?,CLSI02»SUBN02tSUR0S?jFL0Sy2»yERTX2. 
EETVCZnO)  tSUPVCZ(7S>  tSUPPTR(TS)  .CLSVC2(60»  • 
KEHPTS(AO) *N06RP«6HPNAM(60) »GRP0EX(6l) f 
GRHCMK(ftl)  ffiROUPSnZA)  « ^ 

COMMON/r,LOBAL/MEAO<<>l)  •MAPTAPtOATAPE  jSAyTAP.RMFILEtBMKEY* 

hiseil*hiskey*trform,eriptp.frpkey,mapunt»n(»file* 
nPUMAO*nRHwDS.PAGSIZ»r»ATFIL«STAFIL»ASAV*ASAVFL 
.NHSTUN.NhSTFI,SCTMIIN*MAPFIL  ^ , 

.OOTUNT.nOTFlL.NCHPAS»TRNSFL»BMTRFL*HlSTFL.PCHUNT» 
rPOUNT.PWTUNTtWANOlO  „ , ^ 

COMMON/FbL/rFAC.TOTMSHfSEPMSPiPHCKEY.CRIKEy.INCFET. 

INCVFCl ^0) .lC0UNT.StTWGT.EVAL8F< lOOItFETyCAJSOf 
,NOFeT4»VARS7A.CORHAStOTAHAtW6HSl*fPESTVC<lO»  tOIVSlZ 
.ST  ATK  Y » AMRESU.  AORFSP,  ADRESF  . *ORSHji  , A0RSH2 
TMTEGFR  AORfsn.ADMESP. AnWESF.AORSHl . A0PSM2.STATKY 
DOUBLE  PRECISION  CFAC , TOTmSR.SEPMSR 

DIMENSION  rOVMTX ( VARS72.NOSUB2) ♦ AVEMTX (N0FET2.N0SUB2I t 

• FI  OMTX (A.NOFLU/) . VERTE X ( 2. TOT VT2) * 

• Cl snahinocls?) .subnaminosub?) 

data  ONE/1/,SCHSZ2/360O/.RCDTwO/'2»/ 


PRTOOOlO 
PRT0QQ2Q 
PRT00030 
PRTOOOAO 
PRTQ0050 
PRT00060 
PRT00070 
PRTOOOBO 
PRT00090 
PPTOOlOO 
PRTOO  ■■ 
PRTOO 
PRTOO 
PRTOO 
PRTOO  50 
PRTOO  60 
PRTOO  70 
PRTOO  BO 
PRT00190 
PRT00200 
PRTOOZiO 
PRT00220 
PRT00230 
PRTQ0240 


V « 

n 

30 

AO 


C 

C 


WRITE  OUT  TRAINING  FIELDS 

CALL  WRTFLDIFLOMTX.VERTEX.NOFLOZ. I.CLSNAM.SUBNAM) 

print  the  covariance  AND  MEAN 

210  IF  ISTATKY.FQ.O)  60  TO  300 

CNT  » 7*(S.3»?*NOFEr2)*{(NOFET2*ll»/12> 

CNT  = PA6SI7/CNT 
INC  = CNT 

no  PRO  ICLAS  = 1.M0SUB2 
IF  (INC. LT. CNT)  60  TO  220 
WRITE  (S.hEAO) 

TNC  = 0 

??n  WRTTF(G.230)  SlIBNAM  ( ICLAS) 

230  FORMAT  1/1*. 'SUBCLASS  '»AA  ) 

DO  2A0  I.OC  = I .N0FET2. 12 
STOP  = LOCMl  . „ 

TF(  STOP  ,6T.  N0FFT2  ) STOP  * N0FET2 
WRITE (6.2Sn) (LHHN.FETVC2( I ) .RPRN. 1=L0C.ST0P) 

2A0  WRITE  (h. Pbn )( AVFMTX ( I . ICLAS) . I=LOC. STOP) 

2S0  format ( lOX . 1 ?( A3. 12. A 1 . 3X) ) 

2G0  format  l 'OMt’AN' . 3*.  12F9. 2) 
wRTTF  (h.PSO) 

2R0  FoRMATcn  covariance  matrix') 

CALL  WPTMTX (COVMTX ( I . ICLAS  ) .N0FET2.BC0TW0) 

INC  s INC*l 
200  CONTINUE 

300  CONTINUE 
RETURN 
END 


COM00030 

COMOOOAO 

COM00050 

COMOOOAO 

PRT00320 

PRT00330 

PRT003A0 

PHT00350 

PHT00360 

PPT00370 

PRT003B0 

PRT00390 

-PRTOOAOO 

PRTOOAIO 

PRT00A20 

PRT00A30 

PRTOOAAO 

PRT00A50 

•PRT00A60 

PRT00A70 

PRTOOABO 

PRTOOAOO 

PRT00500 

PRT00510 

PRT00520 

PRT00S30 

PRT005A0 

PRT00550 

PRTO0S6O 

PRT00570 

PRTOOSBO 

PPTO0S90 

PRTOOAOO 

PRTOOAIO 

PRT00620 

PRT00630 

PRTOOAAO 

PRTOOABO 

PRTnOAGO 

PRT00S70 

PRTOObBO 

PRT00690 

PRT00700 

PRT00710 

PRT00720 

PHT00730 

PRT00740 

PRT00750 


f/1 


FILEJ  SC*LC 


SU«^POUTINE  SC»LE(MAXX,rtLNCTtINCRE*VSCLAR*XSCLAR»SCLARYtJlLNVLU* 
• YUNVLU*MMOHlZtNOXPf#NOYPT) 

imL'PE_CPM«57.Ll5!.. 

100) tff 


COMMON/F 


L/CFAC* 


V. -w, .OTMSRtSEPMSR.PRCKFY* 

• tNryFC(30)  •icouNT.SETweTjEVALPni 

• .^•OFET4tYAHS7AtCOPeAS*OTAH4tWGHSU(RFSTVC  (10)  *01VS1Z 

.<;TAT«Y.AOPESn»AOR£SP.A(»KESF.A 


•Y.INCFET. 

■FTVCAOO) 


C«ENO 


ADHFSn « AOPESP » AURESF t AUgSHi 
ibUPLE  PRECISION  CFAC*TOTM5R»SEPHSfl 


OHSHl  t 
ItADRS 


ADPSH2 
hz.stat^y 


PFaC  Y^CLaR(MLNCT) » XSCLAP(MmOHIZ) tXLNVLU»YLNVLU«RSAVE«XPTS»YPTS 
niMFNStON  SCI. ARY  <R) 

(;••••  ?PKO  our  SCALE  LABLE  ARRAY  - SCLARY 

nn  moo  i»i*M 

SCI.APY(I)  » 0 


1000 


c* 


CONTINUE 
fF(CPlKFY.E0.3 


CRIKEY. EQ. 4)60  TO 
FOR  X AND  Y AXIS 


1070 


lOPO 

c*  * * 


• oft  • 

OETf-MINE  UAHtLS 

}f^^vOO<Inc5eIs)  .NE.  0)  INCRE  ■ 5 - M00(INCRE»5)  ♦ INCRE 
ISAVF  = INCOF. 
no  lOZO  1*2. R 
SCI  APY(I)  a JSAVF 
ISAVF  = INCWF.  ♦ fSAVE 
f ONT  IMtP 

• OETEWMINF  the  value  OF  EACH  POINT  ON  THE  X AND  Y AXIS 


XPTS 
YPTS 
RS4VF 
XLNVLU 
VLNVI  U 
YS<*LAW( 
XSCLAPI 
PSAVF  = 
no  1040 


11 


NOXPT 
NOYPT 
InCPE 

RSAVF/XPTS 
RSaVF/YPTS 
a 0.0 
a 0.0 
YLNVLU 
laZ.HLNCT 


1040 


YSrLA»m  a PSAVE 
PSAVF  a PSAVE  ♦ YLNVLU 
CONTINUE 
PSAVF  a XLNVLU 

no  inso  laz.HHOPiz 

XSCLAO(I)  a WSAVE 
PSAVF  a WSaVE  ♦ XLNVLU 
lONO  CONTINUE 
PFTUPN 

1070  CONTTNUF 

XPTSaNOxPT 
YPT'irt.'OrPT 
IFXPsT 

no  107S  lal.S 
sriAPY(i)  = 1 


1075 


IFXP 

KaO 


IEXH-1 


/ 10.**IEXP 


00  inno  1*1.7 

Ks<.  1 

RNCRF  a (SCI  ARY(I*U  - SCI. AR Y < I > ) / YP T S 

YSCLARIKjaSCLARYd) 

no  IOhO  JaZ.ivOYPT 

K = K.  1 

10«0  YSCLAPK)  aYSCLAP|K-l)  ♦ HNCRE 
Kan 

00  in?0  1*1,7 

K=K.  1 

XSCLAP (K) aSCLApY ( n 

PNCPP  = (SCLA»Y(I*1)-SCLAHY(I) )/XPTS 
00  iOPO  J = 2,'iOxPI 
KsK*  1 

XSCLA  Ma)  aXSCLARIK-l)  ♦RNCPE 
lOPO  CONTINUE 
RETURN 
ENO 


SCAOOOIO 

SCA00020 

SCAO0030 

SCAOOOaO 

fCAOOOSO 

SCA00060 

SCA00070 

scAoooeo 

SCA00090 

SCAOOlOO 

sCAooilo 

SCA00120 

SCA00130 

SCA00140 

SCAOOISO 

SCAOOIAO 

SCA00170 

SCAOOlOO 

SCAOOlPO 

SCA00200 

SCA00210 

5CA00Z20 

SCA00230 

SCA00240 

SCaooIso 

SCA00260 

SCA00270 

SCA00250 

SCA00290 

SCA00300 

SCA00310 

SCA00320 

SCA00330 

SCA00340 

SCA00350 

SCA00360 

SCA00370 

SCA003R0 

SCA00390 

SCA00400 

SCA00410 

SCA00420 

SCA00430 

SCA00440 

SCAO0450 

SCA00460 

SCA00470 

SCA00460 

SCA0049U 

SCAOOSOO 

SCA00510 

SCAO0520 

SCA0OS30 

SCA00540 

SCAOObSO 

SCA00560 

SCA00S7O 

SCAOObHO 

SCA00590 

NCAOObOO 

5CA00610 

SCAOONZO 

SCA00630 

SCA00640 

SCAOObSO 

SCAOObSO 

SCAOObTO 

SCAOObSO 

SCAOOhRO 

scAon/00 

SCAO0710 


riu  S’.TUP4 


SURROUTINC  SETuR*(ARRAYtTORtSTOPFO»JTlMe*SUBRAY*$UBSIZ} 
IMPLICIT  INTEGER  <A-H»0-ZJ 


PURPOSE..  COORDINATES  ROUTINES  TO  ANALYZE  SUPERVISOR 
CONTROL  CAROS  FOR  •SELECT*  PROCESSOR 

RETURNS..  SUPERVISOR  INFORMATION  ANO  REDUCED  STATISTICS 


HrOQOlO 

5ftooo?“ 

TOOOTi 
T0008< 

iir' 


Kftiigf  S83s;i:tiH 

dimcnsTon  coovec  < It » . « :aro ( zo i 

OIHFNSION  WGHBUF  (400)  .NUHVECOO)  .COMVEC(2) 
dimension  €QUVEC(2) 
data  EOUVEC/1.***/ 

DATA  COOMAJr  /23/ 

DATA  XSI7,  «.'30/.ES|7/100/.8LANK/IH  / .COMVEC/l  • • » •/ 

DATA  Sr*''M4  c/isO/ 

DATA  O v>  C/  ^ M*N».»SURC*.*«EST*.*OPTI».*WEIG***EVAL*.*MOOU*f 
» ■ «jin,.5-Hi;C*»‘CRlT‘.»R-MA*.«INCL*.*I<:Og*.'DATE*»*MEOI*. 

i • rtEOi;  * . »CCM  M , .*ENU‘  ♦ 'SEND*  . *STAT  • . • APRI  • ♦ *BSPA*  . •NCPA*/ 

JNCl  .'.  F CO-^SKh-UST 

NCI  (Hr  C01'  .<7,LIST  . 

OM>  )N<'iNFOwM/NOCLS2.NOSUB2.NOFET?.VARS22.TOTVT2.NOFL02» 

* AVArt?,COVAR2.CLSt0?.SU«NO2.SUHO9?»FL0Svl»VERTX2. 

* FETvrZOO)  .SUHVC2(7S)  .SUPPTpTtS)  tCLSyC2 (60)  « 

KFHPTS(f.'^)  .NO6hP.G«PNAM(60)  .GRPOEXToI)  t 


IlSSi 


SFT003A 
SETOPfSO 
S) TO0T60 

mm 


FTOOAIO 


mtn 

ET00440 

ETOS^SO 


r,KPCMK  (M  ' .GROUPS  (124) 

OIMENS^ION  HEDl  (IS)  .HEOZUS)  .OATF  (T)  tCOHCNTUS) 
equivalence  (Mful ( n .HEfiO(4) ) . (date ( n ♦HEAD(22) ) . 

2 (MEU2(I ) .MFAn(30) ) . (COMFNT (1) .HEA0(48» ) 

C0MM0N/6L0RAL/HEAn(6T> .MAPTAP.nATAPE.SAVTAP.BMFILE.BMFEY. 

• HlSFIL.M|«i»<rv.TRFOMM,ERjPTP.ERPKtY.MAPUNT»NOFILE. 

• DRUMAD.DMMhliS.OAGSIZ.OATFlL.STAFlL.ASAV.ASAVFL  ^ 

• .nhstdn.nhsTFI  .SCT>*UN.*^aPFIL  5ET00460 

• .nOTUNT.OOTFlL.NCHPAS.TwNSFL.BMTRFL.HlSTFL.PCHUNTt  SFT0047p 

• cpihjnt.prtunt.^^andio  SEtooaao 

C'-MON/FSU/CFAC.  rnTMSM."jFFMSR.P»CKEY.CPlKFY.INCF|T*  SET00496 

• INCVtCOO)  .lCOUNT,SEFWG1»tVALHF(i0O)  »FETVC4(30)  SETOOSOO 

• .N(jFFT4.VAPS74*CORMAS.nTAH4..<GHSl4.BCSTVC(10)*DlVSIZ  SETOOSiO 

• .STATKY.ADPFSD.Anwf  SP.A0UF.SF,AnRSHl.A0«SM2  SET00520 

TNTEGEm  AOPESn.AortFSP.inPf SF.AOpshi.AORShZ.STATNY  |£T00|3p 

OOU8LF  PRECIS  10'.  CFAC  . TOTMSR.SEPMSR 

CSCNO  SFT00S50 

COWMfM/  tSTKN/  r,PpPTS(#..i)  . IPRIOR.  KBEST.  NCPASS  SFTOOSAO 

OImFn  .UN  »K0C(T.4)  1 <3.3)  SET00570 

ATA  CWl/'OlVi • • ‘RGtN« ,*CE  •.•TRAN*.*S.  0*»»IV,  •»»BMAT».*T.  0*.  SFT00S80 

•IST.'/  SETOOSOO 

DATA  PROC /'EX.  »r'  jFA'.'RCm  •.•RITH«,*QUT  •.•RPLC*.  SF^OOGOO 

• .i»4Vl*,*'ON  i.  '.•EVL  '.*8  MA*.'TR|X*.'eVAL*.'UATE*»'  •*  IETOOGIO 

• IN  Ti,»  K.  *, ‘PASS'/  SET00620 

DI»*E  .jION  array  (1  ) .CAR0(62)  SET00630 

DIMENSION  SUBRAVm  5ET00640 

HEAL  SiJbRAY  SFT006S0 

DATA  CRCO/*C»/.  SBCD/»S*/»  PHCO/*P*/*  UBCD/»U*/»  FBCO/*F»/  SET00660 

DATA  ROCO/'H*/  SFT00670 

SET00680 
SFT00690 
SET00700 

.............. ... .... ............ TOO  7 1 0 

SET00720 
SFT00730 

... — ....... .... Sf  T00740 

N0GRP«0  SET00750 

........ ........ .... SET00760 


/■  ^ 


riLc  seru^« 


f»0 


WCl.S2«0 
NOfimgaO 
DAfSt>!«0 
■0 


00 


Wiitn\ 


IPftlOff  • 0 
NCP«SSb« 

gUnltlfSi 


20 

8001 

C« 


RHUNfT  > 30 
irtJTlME.fO.nGO  TO  10 
WP1TEC6,HCa01 
W»ITE(6*1000) 

SETUP  HERCftO  BUFFER 

COLL  ftE«EAO<PRUNlT#80) 

NO^  head  card  Into  the  buffer 

READ  (^1«TsMACARD(1)  tl«I*20l 
FDWMAT(?0AA) 

WRITE(RWUnIT.IS)  (ACAROm  «l*lf20> 

REWIND  RRIMIT 

RE  AD ( HRUN I T 1 2000 1 CODE  t CARO 
REWIND  RRUNIT 
WHITE (6«3000)COOE*CARO 
CQL«0 

DO  20  I«ltCOOHAX 

IF<CODvCCin .EO.CODCt  GOTO  ( 30. 40*50*60* 70*80. 100* 120t 130* lAOt 
•15O*l()0*170*180*l4O*200*210*220*3S0*215*205*207*208)*I 
CONTINUE 
WRITE (b.ROOO) 

WQ|TE(6.8001>ACARO 
format (iOA4» 

GO  TO  10 

CHANNFLS  CARD 

FEATURES  CARO  - IF  B-MATRIX 


IF (MMSwT.E  i.l>RO  TO  10 
NOFET?»NUMMEM<rAwn*r6L* 


IS  INPUT  IGNORE  this  CARO 


FETVC2.N0FET2J 


it 

C« 


40 


50 


60 


call  0r0ER{FETVC2*NCEET2» 

60  TO  10 

SUBCLASSES  CARO 

NOSUB?»NUMnER  ICARO.COL  .SlJBVC^  .NOSUB2I 
CALL  OROER(SUHVC2*NOSU82) 

GO  TO  10 

BEST  CARO 

NOBEST>NUMrER(CARO*COL*BESTVC*NOHESTI 
GO  TO  10 

OPTION  CARO  - options  ARE  STATS  OR  PUNCH 

JsNXTCmR (CARn.COLI 
IF  (J.f  'i.CRCO)  wTkFY-1 
ir (j.f 'i.sMrn)  statwti 
If  (.j.f i3,RMcn»  PCHKE1 

IF  ( J,MJ.M-(CO)BUi.XF1 

IF  ( J,»^U.HL*NN)6U  TO  10 


;?:l 

Y»1 


f V 

\n 


[90 


im 


II 

180 

1390 

400 

ill 

1430 

4<«0 

1450 

1460 

1470 

1480 

1490 

isoo 

111: 


i^-so 

/vu 


riLE  $ETU^4 


jBFINO12(CA9ntCOL*C0MVCC) 

|F<Jgta^-nOOTO  10 

WEIGHTS  CARO 

CALL  wGTSCN(CARO«COL*SU0RAYtW6H(IUF*MSIZ*MPTRI 

|ETWGT«2 

GO  TG  10 

FVALUATl  CARD  - A SET  OF  FEATURES  TO  PE  EVALUATED  ACCORDING  TO 
HEOUESTED  CRITERIA 

IFIFFTR.GE.ESITM'O  TO  10 
JaNUMHFH I C ARO . COL  # NUHVEC • 0 1 
FPTH«tPTH*l 
FVALHF  CEPTR) «J 

IFIFPTR*?*J  .LC.ESIZIGO  TO  05 
WRiTECOfAOOO) 

no  90  L«l.J 
FPTR  ■ FPTR*1 
FVALRF  <EPTR)bNUHVEC<U 
CONTINUE 


FPTR  ■ FPTR*1 
FVALRF (EPTR)bNUHVEC<U 
CONTINUE 
60  TO  10 

HOOULE  CARO  DECK  - READ  CARO  DECK  AND  STORE  ON  stA|  FILE. 

call  CROSTA (AHRAY.TOP) 

GO  TO  10 

GROUP  CARO 

J«GRPSCN(CAR0.SY«MAX.6RPTR1 
!F(j.tu.o)r,o  TO  10 
WRITE (6.S000) 

GO  TO  10 

PROCEDURE  CARO  1*EYhAUSTIVE  SEARCH 

?«wITMOUT  replacement  (DEFAULT) 

:«sOAVIDON 
A«USt-H  INPUT 

s»FVALUATE  feature  CHANNELS 
j.NUMPFR ( CARO. col. NC^VEC . 0» 

P»CKFY«NUHVEC(1) 

GO  TO  10 


criteria  CARO 


J*ftVFRAGF  WEIGHTED  DIVERGENCE 
e<»TRANSFORMEO  DIVERGENCE 
3»HHATTACHARYYA 


J.NUMhFR  ( c AWO .COL  . NUHVEC  .(* ) 
rPIKFYrNUHVECd  ) 

IF  (CWIt^EY  ,LT.  1 .OR.  CRIKEY  .6T.  3)  CRIKEY  ■ 1 
60  TO  10 

n-HATRiA  - CAROS  OR  file 

- RHSWT»I  MEANS  B-HATRIX  INPUT  AND  ON  FILE.NOT  IN  CORE 

.(.>g*TCHR(CAPO.COL» 

RMS.T«1 

RM«EYsl 


IF  (.MJF.CRCDJ  GO  TO  10 

CALL  HhFIL  (AROAy.noFF Ta.NOFE T?.FF TVC2. 1 ) 

SET  OATSWT  BACK  TO  ZERO  TO  INDICATE  STATS  MAY  HAVE  BEEN  OVERWRI 

nxTSwTsO 

GO  TO  10 

INCLUDE  CARO  - features  TO  HE  INCLUOED  IN  ‘REST*  SET. 
without  REPLACEMENT  PROCEDURE 

INCFFTa  NUMHFR(CARn.COL. INCVEC. INCFCT) 

GO  TO  10 

ICOUNT  CARD  - NO.  OF  ITERATIONS  FOR  OAVIOON  PROCEDURE 


SET01S30 

pi 

s|T0  600 
SETO  610 

ins  slit 

SETO  660 

pH 

PH 

SllO  710 


SETO  TOO 
SETO  OOO 

l|!8  SIS 

SETO  8A0 

Ins  SIS 

SETO  B60 
SETO  870 
SETO  880 
SETO  890 
SETO  900 
SETO  910 
SET01920 
SET01930 
SCT01960 
SET01950 


SET0i990 

SETO?OO0 

SETO|0l0 

SET02020 

SET02030 

SET02060 

SET02050 

SET02060 

SET02070 


SET02070 

SET02080 

SETO|090 

SET02100 

SFTO2I10 

SET02120 

sfto|i5o 

SET02160 
SET021S0 
SF.T02}N0 
SET02170 
TENSET02180 
SFT02I90 
SFT02200 
5FT02210 
SET02220 
SET02230 
SF.T022*0 
SET022SO 
SFT02260 
Sf T02270 
SET02200 


fr 


FILE  SETUP4 


C« 

170  J»NUMPEH(C«Rr»,COL.NUMWEC»0) 

E*  DATE  CA«0 

180  REAO(30.8000)OATE 
REWIND  RRUNIT 
60  TO  10 

C*  HEDl  CARO 

190  READ(30.6000)ME01  . 

REWIND  RRUNIT 
GO  TO  10 

C* 

C*  HE02  CARO 

200  OEAO(30.6000)HED2 
REWIND  RRUNIT 
GO  TO  10 

C APR I OR I CARO 

205  IPRIOR  = 1 
60  TO  10 

207  J = NUMdER(CARD*COL«NUHVECtO) 
KREST  = NUi^VECm 

60  TO  10 

208  J=NUMREH(CARD«COL«NUMVEC«0) 
NCPASS=NUMVEC(1) 

GO  TO  10 


C* 

C* 


C* 

C* 

c* 


COMMENT  CARD 
210  READ(30.6000)COMENT 
rewind  RRUNIT 
GO  TO  10 

STAT  FILE  NO. 


21R  M = NXTCHHICARD  .COL) 

IF  (M.EQ. BLANK)  GO  TO  10 
IF (M.EO.UHCO)  GO  TO  1702 
IF(M.Et).FPCO)  GO  TO  1703 
1723  WRITE  Di. 755) 

755  FORMATS  ERROR  ON  STAT  FILE  CARO  ♦) 

GO  TO  10 

1702  J=FIND12<CAR0  .COL.EOUVEC) 

IF(J.EO.-l)  60  TO  1723 
MsNUMRERCCARO  .COL .SAVTAP. ZERO) 
C0L=C0L-1 

GO  TO  215 

1703  J=FIND12(CAR0  .COL.EOUVEC) 

IF<J.tO.-l)  GO  TO  1723 

FILNO  = number (CARD  .COL.STAFIL.FILNO) 
STaFIL  = STAFIL  - 1 
C0L=C0L-1 


c* 

c* 

c» 

c» 

c* 

c* 


GO  TO  215 

•END*  - 


END  OF  THIS  SET  OF  CONTROL  CARDS 
GET  STATS  AND  FETVEC  INTO  CORE 


220  CONTINUE 

IF  R-MaTRU  is  input.  OBTAIN  DIMENSIONING  INFORMATION  AND 
FFTVC2  FROM  B«F1LE. 

225  lF(RMSwT.EO.n)GO  TO  230 

CALL  BMFIL  (DUMMY. N0FET4.N0FET2.FETVC2.3) 


C* 

C* 

C* 

C 

C 

c 

c 


2A0 

C 


READ  AND  WFOUCF  STATS 
230  CALL  REOSAV (ARRAY. TOP. BMSWT) 


CODE  ADDED  TO  CHECK  FOR  EXIT  FOR  ONE  CLASS  INPUT 
ON  PROCEDURES  1.2. 3. OR  6 

N0FFT4=N0FET2 
DO  ?Ai)  I = 1.N0FFT? 

FFTVC4(I)=FFTVC2(I) 

CONTINUE 


SET02290 

SET02300 

SETO2310 

SET02320 

iimui 

T02350 
T0236‘ 
T0|37 

toISb 

SET02390 

SET02400 

setoSaio 

SET02420 
SE702A30 
SET02440 
SET02450 
SET 02460 
SET02470 
SET02480 
SET02490 
SET02500 
SET02510 
SET02520 
SET 02530 
SET02540 
SET02550 
SET02560 
SET02570 
SET02580 
SET02590 
SET02600 
SET02610 
SET02620 
SET02630 
SET02640 
SET02650 
SET02660 
SET02670 
SET0268Q 
SET 02690 
SET02700 
SET02710 
SET02720 
SET02730 
SET02740 
SET02750 
SET02760 
SET02770 
SET02780 
SET02790 
SET02800 
SET02810 
SET02820 
SET02830 
SET02840 
5ET02850 
SET02860 
SET02870 
SFT02880 
SET02890 
SET02900 
SET02910 
SET02920 
SET02930 
SET02940 
5ET02950 
SET02960 
SFT02970 
SFT029B0 
Sn  02990 
SET03000 
5ET03010 
SET03020 
SFT03030 
SET03040 


y^2 


FILE  SETUP* 


50 

9*00 


e: 

c* 


260 


270 


C* 

C* 

C* 

280 


C* 

c* 


IF<NOCLS2,GT,1)GO  to  250 
IF(PffCKEY.EQ.*.0R.PHCKEY.F0.5)G0  TO  250 
iriRUNKEY.EO.DGO  TO  250 
wmTC(6t9000l 
GO  TO  10 

CODE  ADDED  TO  QUIT  IF  ONLY  ONE  CLUSTER  INPUT 

IF(N0SUfi2.GT.l)60  TO  260 
yp ITE (6*9400) 

format <5X.rpR06H AM  CANNOT  PROCESS  ONLY  ONE  CLUSTER  INPUTM 
60  TO  10 

CHECK  'HEST*  REQUESTS 

1F(NOBEST.EO.O)GO  to  270 
CALL  eSTCHKCNOBESTI 
IF(N0HEST.GT.0)G0  to  280 
NOHESTal 

ftESTVC(NOBEST>sO 

CHECK  ON  EVALUATE  REQUESTS 


CONTINUE 

FPTRsEPTR*! 

IF(PRCKEY.EQ.6) 

FVALBF(£PTH>*0 


BESTVCdJ  = KBEST 


PRINT  USER  REQUESTS 

WRITEtbt^BOO) (PROC(M»PRCK£Y) *Hslt3>* 

♦ (CRI (M, CRIKEY) tMrl, 3) 

WRITE (6.9310) (RESTVC ( I ). 1*1 .NOREST) 

WRITE(^.93?0) (FFTVC2(I).I=l»NOFET2)  . . 

IF (INCFET.6T.0) WRITE (6.9330) ( INCVEC ( I) t I»1 . INCFET) 
IF(SETwoT.EQ.2) WRITE(6.9340) 

IF(WTKEY,E«.l)  WHITE (6.9360) 

IF(SFTWGT. JE. 2, AND. WTKEY.NE.l) WRITE (6.9350) 

IF  (IRRIOH.NE.O)  WRITE(6.9370) 

WRITE  (6.9380)  NCPASS 

PRINT  OUT  SAVED  TRAINING  FIELDS  AND  REDUCED  COVARIANCES. 

CALL  PRTFLD(ARBAY(COVAR?) . ARRAY ( AVAR2) .ARRAY (FLDSV2) . 

• ARRAY (VERTX2) .ARRAY (CLSI02) .ARRAY (SUBDS2) » 

IF  CLSWT  OPTION  IS  INPUT.  SET  UP  WEIGHT  ARRAY  FOR  INTERCLASS 
SUBCLASS  WEIGHTS. 

W1  a 1 ♦ WPTR  * A 

IF(WTKEY.Ea.l)  GO  TO  9500  ^ ^ 

storage  for  field  information  NO  LONGER  NEEDED. 

MOVE  CLASS  in  information 
and  means  and  covariances. 

REDSAV  STORES  INTO  ARRAY  IN  THE  FOLLOWING  ORDER 

1.  CLASS  DESCRIPTIONS 

2.  NO.  OF  SUBCLASSES  IN  EACH  CLASS 
3, SUBCLASS  DESCRIPTIONS 

A, TRAINING  FIELD  INFO. 

5.  TRAINING  FIELD  VERTICES 

6.  COVARIANCE  MATRICES 

7.  MEAN  VECTORS 

ITEMS  1.2.A.S  NOT  NEEDED  AFTER  PRINTING.  SO  THE  STORAGE 
IS  REASSIGNED  AS  FOLLOWS.  ADDING  STORAGE  FOR  OTHER  ARRAYS. 
1.  SUBCLASS  DESCRIPTIONS 
?.  COVARIANCE  MATRICES 

3.  mean  Victors 
A,  INTFR(SUH)CLASS  WEIGHTS 

S.  INTER (SUB) class  SEPARABILITY  MEASURE  TABLE 


IN  SELECT  DRIVER  'ARRAY*  IS  ALSO  USED  TO  STORE  ADDITIONAL  INFO. 


290 


CONTINUE 

DO  290  I=l.NOSU«2 
ARRAY(CLSll)2*I-?.) 


ARRAY (SU8DS2*I-1) 


Of 


/SS 


' ' - /s 


SET03050 
SET03060 
SET03075 
SETO9O8O 
SETO  ■ 
SETO. 
SETO; 

11181 

IllSiso 

S£T0316f 
SET03I 
SET03 
SET031 
SET03< 
SET03L.W 
SET03220 
SET03230 

iimm 

SET03260 

SET03270 

SET03280 

SET03290 

SET03300 

SET03310 

SET03320 

SET03330 

SETO33A0 

SET03350 

SET03360 

SET03370 

SET03380 

SET03390 

SETO3A00 

SET03AI0 

SET03A20 

SET03A30 

SET03AA0 

SET03A50 

SET03A60 

SET03A70 

SET03A80 

SET03A90 

SET03500 

SET03510 

SET03520 

SET03S30 

SET035A0 

SET03550 

SET03560 

SET03570 

SET03580 

SET03590 

SET03600 

SET03610 

SET03620 

SET03630 

SET036A0 

SET03650 

SET03660 

SET03670 

SET03680 

SET03690 

SET03700 

SET03710 

SET03720 

SET03730 

SET037AO 

5FT03750 

SET03760 

SET03770 

SET03780 

SFT03790 

SET03800 


FILE  SETUP4 


295 


ARPAY(C0VAR2*I-1} 


SUB0S2«CLSI02 
NAsSUBOS?  « NOSUB? 

IWPOS  * «VA«SZ?»NOFET2»*NOSUB2 
00  29S  IsjtlwRDS 
ARRAY(NA«i-n  s 
COVAR?»NA 
AVAR2sC0VAR2  « N0SUB2*VARSZ2 

FROM  HTER  ON  THROUGH  SELECT  SUBLCASSES  ARE  REFERRED  TO  AS  CLASSES 
N0CLS2>NOSUB2 

COMPUTE  BASES  FOR  OTHER  ARRAYS. 


SET03S10 
SET0382ft 
SET03S30 
SET03B40 
SET03SSO 
SET 03660 
SCT03870 

SET03900 
SET039I0 
SET03920 
“T03930 


c* 

c*, 

c*' 


SI 

SET039A0 
SET03950 
SCT03960 
SET03970 
SET039B0 
SET03990 
SET04000 
SETOAOIO 
SET04020 
SET04030 

SET  UP  array  of  INTERCLASS  WEIGHTS  IF  INPUT  - IF  DEFAULT  IS  TAKEN  SETOAOAO 


01 VSIZ=N0CLS2* IN0CLS2-I ) /2 
WGHS1*=AVAR2  ♦ N0FET2«N0CLS2 
0TA84  sWGHSU  ♦ 01VSI2 
COPRAS  = OTABA  ♦ DlVSlz»2 
IC=CORBAS 

IF (COPRAS  .LT,T0P)60  TO  300 
WRITE (6.9100) IC 
CALL  CMERR 


WEIGHTS  ARE  COMPUTED  IN  PRELIM. 

300  if(setwgt,ne.2.and.wtkey,ne.1)  go  to  310 

PASS  KEYS  TO  SUBROUTINE  IN  ALREADY  EXISTING  STORAGE 
array (W6HS1A)  = SETWGT 
NT  s W6HS14  * 1 
array (NT)  s WTKEY 

CALL  WGTCHK (ARRAY (W6HS14) .ARRAY (CLSID2) . SUBRAY. WGHBUF.WPTR* 
♦ SUBHAY (Wl) .NOCLS2) 

SETWGT  = 2 
310  CONTINUE 
RETURN 


C* 

C* 

350 

1000 

2000 

3000 

4000 

5000 

6''-00 

7000 

ROOO 

9000 

9100 

9200 

9300 

9310 

93?0 

9340 

9350 

9330 

9360 

9370 

93R0 

C* 

9500 


SET040SO 
SET04060 
SET04070 
SET04080 
SFT04090 
SCT04100 
SETOAllO 
SET04120 
SET04130 
SET04140 
SET04150 
SET04160 
SET04170 

»END»  CARO  SETOAiaO 
STOPFGal  SET04190 
RETURN  SET04200 
format  <•  SSELECTM  SET04216 
format (A4.6X.62A1)  SET042|0 
format (5X.A4.6X.62Al)  SET04230 
format (•  TOO  MANY  EVALUATE  REQUESTS— REMAINDER  IGNORED*)  SET04240 
format (•  GROUP  CARO  IN  ERROR  - IGNORED*)  SET04250 
format ( lOX, 15A4)  SET0426G 
format  5*  PROGRAM  CANNOT  PROCESS  LESS  THAN  2 CHANNELS*)  SET04270 
FORMAT  (•  invalid  CONTROL  CARD  - IGNORED*)  SET04280 
FORMAT (*  PROGRAM  CANNOT  PROCESS  LESS  THAN  2 CLASSES*)  SET04296 
format  (•  CORE  NEEDED  IN  ARRAY  FOR  THIS  PROBLEM  IS*. 16.*  WORDS*)  SET04300 
format  (•  ERROR  IN  attempt  TO  READ  STATISTICS  FILE-EXECUTION  TEPMINSET04310 


2100 

C* 

c* 

c* 


*ATEO  FROM  SETUP4') 
format (//•  YOU  HAVE  SELECTED  THE  FOLLOWING  OPTIONS**/ 

* 5X,  •procedure* .T35.3A4/  5X. 'CRITERIA* .T3S.3A4) 

FOHMaT(5X.*SELECT  the  best  SET(S)  of*. T35. 10(12.*.*)) 
format (5X. •FROM  CHANNELS*.T35.30(I2.*.*)) 

FORMAT (5X. •USE  INPUT  WEIGHTS*) 
format (SX. *USE  DEFAULT  WEIGHTS*) 

FORMAT (5X. • INCLUDE  IN  THE  BEST  SET.  CHANNELS* . 30 ( 12. *♦*) ) 
format (5X. *USE  AUTOMATIC  INTERCLASS  SUBCLASS  WEIGHTS*) 

FORMAT (SX.'USE  APRIORl  WEIGHTING  TO  MODIFY  INTERSUBCLASS  WTS*) 
FORMAT (5X.  •NUMBER  CHANNELS  PER  PASS  1S*.T35.I5) 
initialize  all  subclass  weight  pairs  to  0.0  IN  WORKING  ARRAY 
continue 

DO  2100  IKs1,n0SUR2 
DO  2100  JK=1.N0SU82 

IDUMr (Wl.IK-1* (JN-1 )*NOSU82) 
nnUM=  ( Wl  .,;K-1  ♦ ( IK-l ) *N0SUB2) 

SUHW*.'  ( IDUM)  sO.  0 
SURRA  ' (llOUM)aO.n 

replace  interclass  subclass  PAIRS  WITH  WEIGHT  « 1.0 

FNDl  = 0 

NK  = NOCLS?  - I 

DO  2200  KI*1,NK 


5ET04320 

SET04330 

SET04340 

SET04350 

SET04360 

SET04370 

SET04380 

SET04390 

SET04400 

SFT04410 

SET04420 

SET04430 

SET04440 

SFT04450 

SET04460 

SET04470 

SET04460 

SFT04490 

SFfOASOO 

SET04510 

SET04520 

SFT04S30 

SET04540 

SET04550 

SET04560 


/u 


FILE  SCTUP4 


500 

400 

2300 

2200 


JJ1*4HRAY (SURN02-1 ♦KI ) 

START 1 » ENOl  ♦ I 
ENOl  ■ STA*«Ti  ♦ JJl  - 1 
DO  2300  I>START1*CN01 
FNnz  « ENQl 
n » KI  ♦ 1 

DO  400  K2  ■ 0.N0CLS2 
JJ2=ARRAY<SUBN02-1»K2» 
ST4RT2  » EN02  ♦ I 
FND2  » START2  ♦ JJ2  - I 
no  SOO  N = STAHT2.EN02 
K0ilHs(wi-l*l4(N-n»N0SUR2) 
KKOUMs (Wl-1 *N* ( I-l ) •N0SUB2) 
SUPHAV(KOUM)al.O 
SUPRAY(KKOUM)sl.O 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 
60  TO  287 
ENO 


SET0A570 

SET04S60 

SET04590 

SET04600 

SET046I5 

SET046H 

SET04630 

SET04646 

SET04650 


SETC'4660 

S€T04670 


SET04680 

SET04690 

SET04700 


SET047id 
SCT0472* 


■T04720 

:T04730 


5CT04740 

SET04750 

SET04760 

SET04770 


FILF 


TRACE 


FUNCTION  TRACE(A,B»N) 

C* 

nOUBLF  PRECISION  TRACE 

C*  FUNCTION  ROUTINE  TO  COMPUTE  THE  TRACE  OF  THE  PRODUCT  OF  TWO 
C*  SYMMETRIC  MATKICEStSTOREO  IN  SYMMETRIC  NOTATION,  THE  DIMENSIONS 
C*  OF  A AND  P ARE  N*<N*l)/2 

C* 

DOUBLE  PRECISION  A,B.SUM,SUMl 

dimension  A(I),B(1)  . ..  . 

KsO 

SUM1=0.0 
DO  20  1=1, N 
M=I-1 
SUM=0.0 

IF(M.EO.O)60  to  is 
SUM=0.0 

no  10  j=i,M  .. 

K=K*1 

in  SLIM  = SUM  ♦ A(K)*8(K» 

15  K=K»1 

SUMl  = SUMl  ♦ A(K)*B(K)  ♦ SUM*2. 

20  continue 

TRACE  * SUMl 
return 

END  ..  


FILI-J  TRNDIV 


C« 

C* 

s: 

e: 

c* 

r 


SUBROUTINE  TRNDIV  <SPHSR ♦ COVmTX . A VEMTX .C0VMT2. AVEHT2* 

• weirht.divtar* 

• WRKRY* IWRKS2  f IPARTtPARTLStBMATt IFULL) 

SUBROUTINE  TO  COMPUTE  THE  AVERAGE  WEIGHTED  TRANSFORMED 
DIVERGENCE*  AND  PAHTIALS  WITH  RESPECT  TO  ,B. 

IF  IFULLsl  COMPUTE  TRANSFORMAEO  DIVERGENCE  FOR  ALL  'NOFET* 
PARTI ALS  CANNOT  BE  COMPUTED  WHEN  IFULL«1. 


CSEND 


C* 


c* 


INCLUDE  C0MRK7.LIST 
DOIIHLE  PRECISION  SPMSR 
INCLUDE  COMhKI.LIST 

COMMON/ INE0RM/N0CLS2»N0SUB?»N0FET?.VARSZ2»T0TVT2«N0FL02* 

* avar?*C0VAH2*CLSI02*SUBN02.SU8DS2»FL0SV2»VERTX2* 

* EETVC2(30) ,SUftVC2(7S) ,SURPTR(75) *CLSVC2(60) « 

* KERPTSdsO) ,N06RPt6RPNAM(60) *GRPDEX(6l) ♦ 

* GRPCHK(^l) .GROUPS (124) 
COMMON/FSL/CFAC*TnTMSW.SEPMSH*HRCKEY. CRIKEY* INCFET* 

* INCVFCC  ^n) .IC0UNT*SETWGT*EVALRF (100) ,FETVC4(30) 

* , N0FET4.VAHS74, COPRAS *UTA84*WGHS14 .BEST VC ( 10) fDIVSIZ 

* .STATKY.AnRESn.AORESP.ADPESF* A0RSH1.A0RSH2 
INTEGER  AOkESO.ADRESP.ADWESF.ADRSHI.AORSHZ.STATKY 
DOUBLE  PRECISION  CFAC.TOTMSR.SEPMSR  . 

INTEGER  VARSZ4 
INTEGER  V4RS72.0IVSIZ 
DOUPl.E  PPFCISICN  RMAT.PARTLS 

double  prectsion  divta8*det.oet2. con. trace 

DOUBLE  PRECISION  C0VMT2. AVEMT2* WRKRY ( 1 ) . T ( 30) 

dimension  COVMTX (V4RSZ2.N0CLS2) * C0VMT2 ( VARS74.N0CLS2) » 

* AVEMTX(N0FET2*N0CLS2) * AVEMT2 (N0FET4.N0CLS2) * . 

* WEIGHT(OIVSIZ) * OIVTAB(DIVSIZ) * PARTLS(l).  BMAT(I) 
TVSZ=V4RS74 

NF=N0FET4 

IFdFULL.EO.  1 ) IV57  = VARSZ2 
IF(IFULL.EQ.1)NF=N0FET2 

icnvi=i 

ICDV?=IC0V1*IVSZ 

1S?=IC0V2*I VSZ  _ . 

Iw1=1S2  * IVSZ 
IS)=TW1 .IVSZ 
ITEST=IS1 

IFCIPART. 1.1.0)60  TO  3 

7EP0  PARTIALS 

I0=N0FET2*i-40FET4 

DO  ? IK=1,I0 

P«RTLS(IK)=n.0 

TW7=IS1 .VARSZa 

tW3=lW?* 10 

1W6  = I 10 

ITCST=IW4.I0 

CONTINUE 

if(i>-'Rksz/2.6e.itest)go  to  1 

WRITE (G.600) IWRKSZ 

CALL  CMERR  . . 

CONTINUE 
SPMSR=0,0 
MN  = 0 

NC=N0CLS2-1 
00  100  1=1. NC 
NS=I*1 

FIND  INVEWSF  COVAR  FOR  CLASS  I 
DO  5 11=1. IVSZ 

IF  ( IFIII.L  .EO.  1 ) WPKPY  (II)  =C0VMTX  { 1 1 . I ) 

TFdFlILL.NE.l  )WB^RY(I  I)=C0VMT2(I1*I) 

CONTINUE 

CALL  CDL  IMV  (ICOVl ) .NF.IEPR.3.0ET) 

IF (IFRP.F 0.0)60  10  6 
WRITE (G.SOO) I 
GO  TO  ion 
DO  SO  J=NS.noCLS2 
no  7 ii=i,NE 

IFdFULL.EO.  1 ) T (I  I ) = AVFMT)i  (I  I . I )-AVEMTX  (1 1.J) 

IFdFUlL.NE.l  )T(II)=AVEMT?(II.I)-AVFMT2dI,J) 

CONT  IN!)E 
MN=MN.l 
K = n 


TRNOOOIO 

TRN00020 

TRN00030 

TRNQ0040 

TRNOOOSO 

TRN00060 

TRN00070 

CHANNETPN00080 

TRN00090 

TRNOOIOO 

TPNOOnO 


TRN00120 

TRN00130 

TRN00I40 

TRN00150 

TRN00160 

TRN00170 

TRN00180 

TPN00190 

COMOOOlO 

COM00020 

COM00030 

COM00040 

COM00050 

COM00060 

TPN00270 

TRN00280 

TRN0029C 

TRN00300 

TRN00310 

TRN00320 

TRN00330 

TRN00340 

TRN00350 

TRN00360 

TRN00370 

TRN00380 

TPN00390 

TRN00400 

TRN00410 

TRN00420 

TRN00430 

TRN00440 

TRN00450 

TRN00460 

TRN00470 

TRN00480 

TRN00490 

TPNOOSOO 

TPNOOSIO 

TPN00S20 

TRN00530 

TRN00540 

TPN00550 

TRN00560 

TRN00S70 

TPN00S8O 

TRN00590 

TPN00600 

TPN00610 

TRN00620 

TRN00630 

TRN00640 

TRN00650 

TRNOObftO 

TRN00670 

TPNOObflO 

TRNO0&90 

TRN00700 

TPN00710 

TPN00720 

TRN00730 

TRN00740 

TPN00750 

TRN007GO 

TRN00770 

TPN00780 

TPN007R0 

TPNOOaOO 


FILP!  TRNOIV 


no  1? 
no  I? 

K«K*1 

IF(IFULL.^»E.1 
WRFftY(TS2*K-l 
fiO  TO  I 2 


) GO  TO  10 

) aCOVMTX (K . I ) ♦COVHTX (K« J) »T ( 1 1 ) *T ( IJ) 

♦ C0VMT2(K»J)  ♦ T(II)*T(IJ1 


C* 

g: 


c* 


♦ T(11)*T(IJ) 


C* 


c* 

c* 

c* 


10  WRKRY(tS2*K-l)sCOVMT2(KfI) 

IF  PART^XLS  ARE  TO  BE  CALCULATED  COMPUTE  FULL  »S*  MATRIX  FOR 
CLASSES  I AND  J 

IF(IPART.LT.O)60  TO  25 
no  IS  TI=l.fOFET2 

15  TdDsAVEf'TXUI.I)  - AVEMTXdl.J)  . 

KsO  ■ 

no  20  I1  = 1.N'0FET2 

no  20  ijsi.n  , 

KsK*l 

?0  WPKRY(IS1*K-1)*C0VMTX(K»I)  ♦ C0VMTX(K*J) 

FIMD  INVERSE  FOR  CLASS  J 
PS  no  30  11=1.IVS7 

TFdFIILL.EO.)  )««ORY<  IC0V2*1I-1)=C0VMTX(II.J) 
IFdFULL.NE.l)WKKRYdC0V2»Il-l)=C0VMT2{II»J)  - - 

30  CONTINUE 

CALL  C0LINV(WRKRY(IC0V2> tNF»lERR»3i0ET2)  ..  . 

TFdERP.EQ.niGO  TO  35 
WPITF(<^.S00>  J 

no  TO  PO  _ _ • 

SUM  INVERSES  AND  COMPUTE  TRACE  OF  SUM  ♦ S2 
3S  no  *0  II=1*TVSZ 

40  WPfPY(IWl*n-l)=wPKRYdCOVl*II-l)  ♦ WRKRY(IC0V2*II-1) 
niVTAR(MN)sTR4CE(VRKRYdWl)fWRKRYdS2)*NF)/2.  - 2.*NF 
DIVTAH('»N)=0EXP(-0IVTAB(MN)/16.) 

SPMSR  = SP^SP  ♦ niVTAB(MN)*WElGMT (MN) 

IF<IPaRT.LT,0)G0  to  90 

COMPUTE  PAHTIALS 

CALL  MTl  (HMAT,C0VMTX(1.  I)  *WRKRYdW2)  *N0FETA.N0FFT2) 

CALL  MT3(WRXRY(1C0V1)  «WHNRY(IW2)  .»<HKRYdW3)  ♦N0FET4»N0FETA»N0FET2 

*CALL  MT3(WRKRYdS2)  *WRKRVdv3)  *WRKRYdW2)  »NOFET4»NOFET4»NOFET2* 

*CALL  MT3 (RMfiT.WRKRY (ISl ) »WRKRY(IW4) ,NOFETA*NOFET2»NOFET2»0» 1 ) 
no  42  IK=1*IQ 
LsTK-1 

A?  WRKRY(TW4*L)=WPKRYdW44L)-WRKRY  dW2*L) 

CALL  MT3<'*R'^PYdCnvi),WRKRYdW4)  ♦WRKRYdWp)  .NOFETAfNOFETA* 

* ^;oPFV?-ltO) 

CALL  MTl  (PM»T,COVMTXd»J)  »WRSRY(IW3)  .N0FFT4tN0FET2) 

CALL  MT3  ( wRkry  ( IC0V2)  . WRKPY  ( 1«(3)  tWRKRY  (1W4)  »N0FET4tN0FET4 » 

*CALL  MT3(wR^RY?IS2? .WPKRY (1W4) * WRKRY ( IW3) »N0FET4»N0FET4* 

* UOFFT2»1.0) 

CALL  MT 3 (PM AT, WRKRY ( ISl ) ,WRKRY (IW4» ,NOFET4»NOFET2»NOFET2»0» 1) 

no  43  TKrl,IO 

L=IK-1 

43  WRKRY(IW4*L)=WRKPYdW4*L)-WPKRY(IW3*L) 

CALL  MT3(wR-<MYdC0VP>  ,WHKRY(1W4>  ,WHKRYdW3)  ,N0FET4,N0FET4» 

♦ NOFFT2»1,0) 
no  44  IK  = 1,I(J 
L=TK-i 

44  WRKPY ( IW?*L» sWRKRY ( IW?*L)  ♦ WRKRY(IW3*L) 

CON  s WEIMHTC^N)*0IVT4a(MN)/d(S.*N0CLS2) 

no  so  1K=1,I0 

ParTL5(IK)=parTLS(1K)  - C0N*WRKRY(IW2*IK-1» 

SO  CONTINUE 
OO  CONTINUE 
100  rONTINUE 

SPMSP  = SRMSP/N0CLS2 
PFTUPN 

KOO  FOOMATC  REOUCeO  COVARIANCE  MATRIX  FOP  CLASS'»I3»*  IS  NO’'  POSITI 

• nFFIuITE*) 

f,nO  FODmaTC  not  enough  <,0RK  area  in  TRNOIV  — IWRKSZs',15) 

FNO 


TRf^OOSlO 

TRN00B20 

TRN0083Q 

TPN0OM4O 

TRN00850 

TRN00860 

TRN00870 


TRN0089C 
TRNC0900 
THN00910 
TRN00920 
THW00930 
TRN00940 
TRN00950 
TRN00960 
TRN00970 
TRN00980 
TRN00990 
TRNOIOOO 
TRNOlOlO 
TPN01020 
TRN01030 
TRN01040 
TRN01050 
TRN01060 
TRN01070 
TRN01080 
TRN01090 
TRNOl 100 
TRNOlllO 
TRNOl 120 
TRN01130 
TRN01140 
TRN01150 
TRN01160 
TPNOllTO 
TRN01180 
TRNOl 190 
, TRN01200 
TRNOl 210 
TFN01220 
TRN01230 
TRN01240 
TRN01250 
TRN01260 
TRN01270 
TRN012RO 
TRN01290 
TRN01300 
TRN01310 
TRN01320 
TRN01330 
TRN01340 
TRN01350 
TRN01360 
TRN01370 
TPN01380 
TRN01390 
TRN01400 
TPN01410 
TRN01420 
TRN01430 
TRN01440 
TRN01450 
TRN014#.0 
TRN01470 
T4N01480 
TPN01490 
TR.NOISOO 
TRNC1510 
VKIRNO 1520 
TRN01530 
TRNni540 
Tkt  UlbSO 


FILF:  TRNSFR 


SUBROUTINE  TRNSFR<A»A2»WiBMAT) 

C INCLUDE  CdMKKTtLIST 

C INCLUnP  CONRkI.LIST 

COMHON/1NFOPM/NOCLS?»NOSUB?.NOFET2,VABSZ?»TOTVT2«NOFLD?* 

• AVAW2,C0VAH?,CLSI02fSURNO2.SUft0S2»FL0SV2«VERTX2, 

• FFTVC?(30»  tSUHVC2(7S) ♦SUBPTk(75) .CLSVC2I60) ♦ 

• KFPPTSCAO)  »NOG«P»GHPNANJ60)  «GRPOF.X(^lJ  » 

• GPPCMK  (M)  .RPOUPS(l?A) 
COMHON/FSL/CFAC«T()TMSR.SEPMSHfPPCKEY iCHIKEY* INCFETt 

• lNCVEC(?n),ICOUNT.SETwGT.EVALBF(100).FETVCA(30)^, 

• .NOFFTA.VAPSZA.CORHAStnTABAtWGHSlA^BESTVCnO)  tOlVSIZ 

• ,STaTKY«ADPFSO.ADRESP, AOKtSF, ADPSHI ,ADR5H2 
INTFREP  AORFSn.AOPESP»AfJMFSF«ADPSHi  .A0RSH2*STATKY 
DOUBLE  PHECTSION  CFACtTOTMSW*SEPMSR 


CSEND 


C« 

C* 

C* 


(N0FETA.N0FET2) 


TNTE6FR  VARS7**VARS72 
DOUBLE  PRECISION  SUM 
DOUBLE  PRECISION  BMAT (N0FET4tN0FET2) 
nOUBI.E  PRECISION  A2(VARSZa.N0CLS2)  »W 
DIMENSION  A(VARSZ2»NOCLS2) 

multiply  BMAT  * a * BMAT (TRANPOSE)  ANO  STORE  IN  A2 

DO  I^-O  Jjsl.NOrLSZ 

no  ISO  i=i.nofEta 


c* 


no  ISO  J=l.NOFET2 
SUMsO.O 

no  lAn  K=1.N0FFT2 
IF(K.GF.J) IP=K*(K-l)/2  ♦ J 
IF(K.LT.J) IP=J*(J-l)/2  ♦ K 
140  SUM=SUM  ♦ BMAT(ItK)*  A(IP,JJ> 
W(T,J)=SUM 
150  continue 

no  IPO  I = I«V'UFET4 
no  170  J=1.M0FET4 


‘JUMso.n 

no  IPn  k=1*nOFFT2 
IFiO  Sl)M=SUM  ♦ W(J.K)  • BMAT(I,K) 
TFU.6F.I)  I?=J*(J-l)/2  ♦ I 
IF(J.LT.I) IP=I*(I-1)/2  ♦ J 
A2( IP. JJ) =SUM 
170  rOMTlNUf 
IPO  CONTINUE 
lOO  CONTINUE 
RFTURN 
ENO 


TRNOOOlO 
TRN00020 
TRN00030 
TRNOOOAO 
TPN00050 
TPN00060 
TRN00070 
TRNOOOBO 
COMOOOlO 
COM00020 
COM00030 
COHOOOAO 
COMOOOSO 
COM00060 
TRN00160 
TPN00170 
TRNOOiaO 
TPN00190 
TRN00200 
TRN002I0 
TRN00220 
TWN00230 
TRN00240 
TRN00250 
TRN00260 
THN00270 
TRN00280 
TRN00290 
TRN00300 
TPN00310 
TRN00320 
TPN00330 
TRN00340 
TRN003S0 
TRN00360 
TRN00370 
TPN00380 
TPN00390 
TRN00400 
TRN004] 0 
TPN00420 
TRN00A30 
TRN00440 
TRN00450 
TRN00460 
TRN00470 
TRN00480 


FILE*  USERIN 


SURROUTINE  USER1N(COVMTX»AVEHTX»OIVTA8» WEIGHT tCOVMT2tAVFMT2»S*S2f 
• BMAT*WRKRY*1WRXSZ) 


ssARY  routines  to  compute 

THE  INPUT  B-MATHIX. 


csEwn 


SUBROUTINE  USERIN  COORDINATES  THE  N 
tME  REOUESTEO  SEPARABILITY  MEASURE 

INCLUDE  COMBKl.LIST 

ioMMON/INFOBM/NblLl2«NOSU«2tNOFET2»VARSZ2.TOTVT2*NOEL02f 

• AVAR?,COVAR?«CLSI02*SUBN02»SUROS2.FLOSV2.VERTX2» 

• FETVC2(30) tSUBVC?(75) .SURPTR ITS) .CLSVC2 (60> ♦ 

• KEPPT^(AO) *N06RP*GRPNAM(60) •GRPDEXC61) « 

• GRHCHK(6l>iGR0UPSI12A»  .. 

common/fsl/cfac.totmsr»sepmsr*prckey»crikey*incfet* 

• IMfVEC«10» ♦ICOUNT.SETWGTiEVALBF(100».FETVCA(30)„,,,^,_ 

• .NiOFFT4.VAP5Z4»CORHAS«PTAflAtWGHS|4»BESTVC(lO) tOIVSIZ 

• ,STATKY.#r)RE50.ADRESP«AnPESF.AURSHi»ADRSH2 
integer  ADRFSn.AORESPtAORFSFf A0RSH1»A0RSH2*STATKY 
DOnpl.E  PRECISION  CFAC»TOTMSRfSEPMSR 

integer  CRI*«FY.VARSZ2tVARSZA 
OIMENSTON  C0VMTX«VARSZ2«N0CLS2) 

S(VARSZ2*NOrLS2) . 


» AVEMTX(N0FET2*N0CLS2> t 
double  PMEClii6N'c6vMT2(VAR§Z4.1) fAVEMT2<N0FET4tl) t ..  . 


RflC’MT  (J)  .WRXRY^Ij. 


CB 

C* 

C» 


C* 

C* 

C* 


C* 


C* 

C* 

C* 


* S2<vaRSZ<».1)  »BMaT(1) 
double  precision  OIVTABU) 
niMENSION  DUM(l) 

GET  B-MATRIX  from  FILE  IN  SINGLE  PRECISION  THEN  STORE  IN  O.P. 

CALL  BMFIL(RPKRY,N0FET4«N0FET2»FETVC2»2) 

IK»N0FFT4*M0FET2  

no  10  IsI.IK 

10  Bm»T(I)=WRkRV(I) 

GET  transformed  statistics 

CALL  GTSTAT  JC0VMTX*AVEMTXfS.C0VHT2tAVEMT2»S2*DUM,flMAT»WRKRY» 

* IWRKSZ) 

EVALUATE  SEPARABILITY  MEASURE 

CALL^EVALSP(SFPMS«»COVMTX. AVEMTXtS*COVMT?« AVEMT2»S2»0IVTA6, 

* wEIGHT.IRARTtOUM»BMAT*WHKRY»lKRKSZ) 
IF(CRIKEY.nE.1)RETURN 

EVALUATE  INTERCLASS  DIVERGENCES 

CALL  OIVRGI (COVMT?*VARSZ4»AVEMT2f0IVTA8tN0CLS2tN0FET4» 


RETURN 

END 


• RtfRY.  IwRKSZ) 


USEOOOlO 
USE00020 
USE00030 
USEOOOAO 
USE 00050 
USE00060 
USE00070 
ysEooodo 
COMOOOIO 
COM00020 
COM00Q30 
COM00040 
COMOOOSO 
COMOOOIO 
COM00020 
C0M00030 
COMC0040 
COMOOOSO 
COM00060 
USEOOlOO 
USLOOIIO 
USE 00 120 
USE00130 
USE00140 
USEOOISO 
USE00160 
USE00170 
USE 00 1 BO 
USEOOIRO 
USE00200 
USE00210 
USE00220 
U5E00230 
USE00240 
USE00250 
USE00260 
USE00270 
USE002B0 
USE002RO 
USF00300 
USE00310 
USE00320 
USE00330 
USF00340 
USE003S0 
USE00360 
USE00370 
USE003B0 
USP003V0 
USE00400 
USE00410 
USF00420 


FILFl  W6TCHK 


<iU«f»OUTINF  WbTCMK  (WEIGHT. CLSNAM*NAMPR»W6MT»WPTR»WRKRYtN0CLS2) 

ip  AL  * WP I GMT  If  ?^W(SMT  ( i ) . WRKRY  ( flOCLS?«NOCLS2  > « WHT 
OI*<ENSION  CLSNAM(N0CLS2>  .NAHPR(2»wRTR) 

Rf»L  ftwGR.RKFY 

. .csto«,Lsio»an . <NSTO«. 

C»  OASS  KEYS  IN  ALREADY  EXISTING  STORAGE 

RWfiT  s WFlGHT(l) 

RKFV  = WEIGHT  (?) 

C*  DELETE  blanks  FOH  TESTING 

DO  ?n  I«I,N0CLS2 
LSTOwE  « CLSNAMd) 

NS TORE  a BLANKS 

IZ  8 1 

DO  m TY«1.A 
ITpmpsblanks 
I TPMPI4  ) =LSTOf>(  lY) 

IF( (ITF‘ P.EO.HLANK) .and. (IZ.EQ.l) )GO  TO  10 
NSTOR(IZ)  s LSTOH(IY) 

I?  a 17  ♦ 1 
10  CO^'TTNUF 

?0  CLSN*M(I)  s NSTOPE  . 

IF(WTKEY.EO.l)  GO  TO  27 

SET  ALL  CLASS  PAIR  WEIGHTS  TO  l.O  IF  USER  HAS  NOT  INPUT  WEIGHT 
'•others*  or  'CLSwT*.  SET  TO  'OTHERS*  VALUE  IF  INPUT. 


C* 

C« 


OTHERS) GO  TO  22 


?? 

2A 


C* 

C** 

C* 


?S 


27 


r** 

r** 

c» 

c** 


c* 

c* 

c** 


WHT=1 ,n 

no  22  Tal.wPTR 
IE(NAHP3(i.I)  ,Nt. 

WHTsVnHTd) 

GO  TO  ?A 
CONTINUE 

no  2S  tK=l.U‘0CLS2 
DO  2S  Jk=1.nOCLS2 
WPKHY(IK»JK)aWHT 
WRKRY (JK, IK) aWHT 

PLACE*'ENT  of  INPUTEO  WEIGHT  VALUES 

IF(SFTwgT.NP.2)  GO  TO  55 
no  50  T s l.wPTR 

DO  40  Jal.NOCLS?  ^ ^ 

IF(CLSNaM(J)  .NE.  NAMPR(I.I) )G0  to  40 


FOUND  “ATCH  ON  FIRST 
NOW  SEE  ABOUT  SECOND 


NAME  IN  NAMPR  - INDEX  J 
NAME 


BLANK)  60  TO  35 
NAMPR(2. I) )G0  to  30 


TO 


C* 

C* 

C* 


r« 

c* 

c* 


3*i 

IN 

40 

4G 

so 

S5 


IF(N6MOw(2.I) .FO, 

DO  30  K=1,n0CLS2 
IF(CLSNAM(K)  .Nt. 

FOUND  second  match  - INDEX  K 

WRKRY (J.K) aWGHT ( I ) 

WRKRY  (K,J)  aW'jHT  ( I ) 

GO  TO  SO 
rOMT INUE 

WPITF(K.IOO)  NAHPR(2,D 
GO  TO  SO 

ALL  PAIRS  FDR  CLASS  J SET  TO  SAME  WEIGHT 

no  3A  IK=1.N0CLS2 
WRKRY  ( IK.  J)  =wr,H  r ( I ) 

V-PKRY  ( J.  IK)  =WGHT  ( I ) 

GO  TO  SO 
FONT  INI  IF 

IF  (NiRPR ( 1 , I ) .EO.  OThERS)00  TO  50 
WRITF(S,100)  NAi-HR(l.I) 

CONTINUE 

CONTINUF 

REDUCE  WRKRY  yATRI*  AND  store  IN  WEIGHTS 

KaO 


WGTOOOIO 
W6T00020 
WGT0Q030 
WGT00040 
WGTOOOSO 
WGTOOOGO 
WGT00070 
WGTOOOSO 
WGT00090 
W6T00100 
wOTOOilO 
WGTOOUO 
WGTOOISO 
WGT00I40 
WGTOOISO 
WGT00160 
W6T00170 
WGTOOieO 
WGTC0190 
WGT00200 
WGT00210 
W6T00220 
W6T00230 
W6T00240 
W6T00250 
WGT002G0 
W6T00270 
FORWGT00280 
WGT00290 
WGT00300 
WGT00310 
WGT00320 
WGT00330 
WGT00340 
WGT00350 
WGT00360 
WGT00370 
WGT00380 
WGT003R0 
WGT00400 
WGT00410 
WGT00420 
WGT00430 
WGT00440 
WGT004S0 
WGT00460 
W6T00470 
W6T004B0 
W6T00490 
WGT00500 
WGT00510 
WGT00520 
WGT00S30 
WGT00540 
W6T00550 
WGT00560 
WGT00570 
WGT005AO 
W6T00590 
WGT00600 
WGT00610 
WGT00620 
W0T00B30 
WGT  00040 
WGTOOOSO 
wGTOOOOO 
WGT00670 
WGTOOISBO 
W6T00690 
WGT00700 
WC-T00710 
W6T00720 
WGT00730 
WGT00740 
WGT00750 
wGT  00700 
WOT00770 
WGTiiOTfiO 
WGT00790 


jxr 

/3/ 


tLf.t  W6TCHK 


NC■^<OCLS^-l  . 

^0  l«i.NC  * 

♦1 

. , iO  J-IK.N0CLS2 
K«K»1 

weiGHT(K)>wPKRY(I«J) 
ftO  CONTINUE 
PETURN 

lOP  P00MAT(*  subclass  »tA6»*  IS  NOT  AMONG  INPUT  SUBCLASSES  - 
•PUT  IGN’OPEO*) 

END 


WGT00800 
UGT00810 
wGTOOBfo 
MGT00830 
WGTOOBAO 
WGT008S0 
WGT00860 
WGT00870 
WEIGHT  INWGT00880 
WGT00890 
WGT00900 


oor»oo.-ir»onrynor>.'>rK->r»r»rior>rK>r> 


FiLri  W6TSCN 


|jJgPOUT|l»e  W?T5CN  < C APO  » COL  tN AMPR  t WGHT  t WS I Z »NCNT ) 


INTf6ER(A-2) 


CALL. 


e: 


c* 


c* 

c* 

c* 

c* 


r.» 

f 


J« WRTSCN ( CARO  * COL  f N«MPR  * WGHT  * WS I Z I 


ARCS...  CARO  - ARRAY  OF  CHARACTERS  TO  BE  SCANNED. 


ONE  CHARACTER  HER  COMPUTER  WORD. 
‘JQ  TO  BEGIN 


COL  - COLUMN  IN  CARO  TO  BEGIN  SCAN.  ON  OUTPUT 

COL  IS  LAST  COLUMN  OF  CARO  SCANNED.  , 

NAHPR-  ARRAY  CUNT A ININ6.0N  OUTPUT.  THE  PAIRS  OF  CLASS 

names  scanned  from  card. 

WGHT  - AWPAY  CONTAINING  WEIGHT  FOR  CORRESPONDING 
CLASS  PAIR 

WSIZ  - SIZE  OF  WGHT  BUFFER 


NCNT  - RUNNING  COUNT  OF  NARF  PAIRS  SCANNED 

PURPOSF. SCANS  the  weights  CONTROL  CAPO*  SAVING  THE  CLASS  NaMF 

PAIRS  AMO  ASSOCIATED  WEIGHT  FOR  LATER  VERIFICAT TONKIN  , 
SUSBOUTINE  WGTCHK,  THE  WEIGHT  CARO  MAY  TAKE  THE  FOLLOWIN 
FORMS! 

WEIGHT  CLASS  U10.5.CLASS  Z*1Z.0«  OTHERS«20.0 
OR! 

WEIGHTS  (CLASS  NCLASS  2) -IS.O.CLASS  3«1 . 0,0THERS»S 

’""oiMENsToN'cOKvicTpTTEOUVEcTiT.RPN^  . , 

data  blank/*  */»LFTPRN/* C/.COMMA/'t'/^EOUAL/'s'/.RHTPRN/*) •/ 

oata  blanks/*  '/ 

DATA  CnHvF.C/l.'»  •/*EOUVEC/l»*«»/»RPNVEC/l.*)  •/ 

PFAI.  WGHT 

OIMFNSION  CARO ( 1 ) .NAMRR(2, 1 ) .WGHT (1) 

LOGICAL**!  LSTORI*)  ,LCARO(A) 

equivalence  (MCAR0*LCAR0(  1 > ) « (STOR.LSTORd)) 

1 J«NXTCMR(CA»0«COL> 

IFtJ.t'O.BLANKJGO  TO  60 
IF( J.Nr.LFTPRN)60  TO  2 
rOLsrOL*! 

2 continue 

PLANK  <5UT  NAMPR  FOR  THIS  PAIR 
NCNTsNCNT*! 

no  .1  I»1.2 

3 NAMPRl I *NCNT) .blanks 
lO.wsiZ-NCNT 
IF(1R.6T,0)GO  to  a 
WRITE(6.200)WSIZ 

GO  TO  60 

4 CONTINUE 
STOOsRL ANKS 
went  b 0 

6 WCNT  » WCNI  ♦ 1 

IF  (Cft^'MCOLl  .E'J.HLANK)  60  TO  10 
IE<rftRn(Ci>U  .fft.KMJALlGU  TO  45 
lEfCARO(COL) .fO.COHMA)GO  TO  20 
HCAPO  B C4W0(f.nL) 

LSTOR(UCMlBLCftHO(l) 

NAwpp ( 1 ,nCNT»  bSTOR 
10  rOLsCOl •! 

IE(wrNT.E0.4)G'J  TO  15 
GO  TO  6 

OnI  Y Fuue  CMABACTfHS  Ptw  NAME  ALLOWEO  - IGNORE  REMAINDER 
FIND  s OW  t - FWHOR  otherwise 

IS  CONTIN'JF 

• IbFINOI  2(CapD.C0L«C0MVEC) 

IF<J.FO. -1)150  TO  40 
GO  TO  IR 

comma  found  - another  name  SHOULD  FOLLOW 

lo  WCNT  = 0 
9ft  COlsCOLM 
2)  wc*iT  B *CNT  • 1 
STOR  s .PLAN'S 

IF  (rAon(CoL)  .f^O.phtmwn)  (jO  TO  40 
IF(CAWn(COL) .FP.HLANk)GU  to  2S 


WGTOOOlO 

W6T0002Q 

IWGT00030 

WGTOOOAO 

WGT00050 

W6T00060 

WGT00070 

WGT0006U 

WGT00090 

WGTOOlOO 

WGTOOiiO 

WGT00120 

WGT00130 

twGTOOlAO 

IWGTOOiSO 

IIISI  II 


[WGTOO 


BO 


[WGTOOIRO 
[W6T00200 
WGTOOf 
W6T00< 
WGTOOj 
twGTOO< 
WGIOO: 
WGTOOj 
WGTOOl 
WGT002H0 
WGTD0290 
W6T00300 
WGT00310 
W6T00320 
WGT00330 
W6T00340 
W6T003S0 
W6T00360 
WGT00370 
WGTftOSSO 
WGT00390 
WGT00400 
W6T00410 
WGT00420 
WGT00430 
W6T00440 
W6T004SO 
WGT00460 
W6T00470 
WGT004BO 
WGT00490 
wGTOOSOO 
WGTOOSiO 
W6T00520 
WGTOOS30 
WGT00540 
WGT00550 
WGT00560 
WGT0OS7O 
WGT005BO 
WGT00590 
W6T00600 
WGT0O6IO 
W6T00620 
WGT00630 
WGT00640 
.6T006SO 
WGT00660 
wGT  00670 
WGT006AO 
WGT00690 
WGTOO/00 
WUT00710 
w(.T007?0 
wGT  00730 
Wi<TCft746 
wr,T007SO 
WGT00760 
wGTn0770 
WGT007M0 
WGT00790 


riLFl  WOTSCN 


MCARD  B CMn(COL) 
U5TOP(wCNn  B LC*f»0(U 
Namprj?,ncNT>bSTOR 
?%  COLbCOLM 

fF|WCNT.E0.4)G0  TO  30 
«»0  TO  2\ 

■»«  CONTI NUK 

JbF  ! NDl  X < C *»[) » col  t RPNVEC ) 
IF<J.NF.-I)GO  TO  40 
W9TTMft,l00) 

NCNTbNCNT-1 
60  TO  60 


40  JsFINO12(C**»0»C0L.EOUVEC) 

IF (J.NE.-l »GO  TO  45 
WPTTF(»««iOO» 

MCNTmNCNT-l 
60  TO  66 

46  J*Fi  TM(M<CA»DtCOL.k(GHT(NCNT»  »IR» 
COI.  = COL-l 

j«NXTCHM(CARn»COU 


IF(J.FO.COi^«4»66  to  1 
IF(J.fo.aLAM6)60  TO  60 
1F(J.^F.LFTPRN)60  to  2 
COL«COLM 
60  TO  ? 

60  CONTINUE 
RFTUPN 

ion  F0O*<4T(»  syntax  EPPOB  on  weight  CAR0-REM4IN0ER  OF 
?00  F0PM4TC  WEIGHT  BUFFER  IS  F IllEO-ONLY • » ISt • CLASS 
••"Dn  ... 

END 


WGT 00060 
W6T00070 
W6TAOOOO 
WGT 00090 
WGTOgOOO 

wGTgooIo 
WbTOOOfo 
wr^T  00930 
WOT00940 
WGT0095g 
WGT00960 
WGT00970 
WGT 00960 
WGT 00990 
wGTOlOOg 
WGTOioiO 
WGTOiolO 


WGT 01 050 
WGT01060 
WGT01070 
WGT01060 
WGTOi090 
IGNORFOt)  wGTOilOO 
PAIRS  ALLOWwGToniO 
WGTO1I2O 
WGTOiiaO 


10-64 


FiLFt  WHBPLC 


SUAROUTINC  *<HHPLC<C0VMTX,*vENTXt0IVTM.wn6MT»C0VMT?» 
► *VtMT2»StS2»*<RR«y*Iw»KS/) 

OF  NOFFT*  FEATURES 


SUBROUTINE 
lISlNft  The  h 

1NTE8EB  FETVC2.FFTVCA»TVCC.TPyvEC»KEEP 
tNCLUrvE  C0«^K7»LI§T 
INCLUnP  COMBUl.LIST 


i?mout^»eplacImenI^phoceourC. 


C$ENO 


f • 
C» 

c* 


c* 

r« 

c« 

c* 


A 

in 

IS 


?n 

?n 

?*. 


common/ 1NF(1uh/NOCLS2,NOSUB2»NOFET?.V*»S7?* TOT VT?»N0FU02# 

AVAR?,COVA«?tCL§102.SUflNO?.SllBOS?tFLOSV2.veRTX?* 
FETVC2«30)  .SURVC2«fS)  .SURPTMITSI  .CI.SVC2 16(11  * 
KFHPTS(NO) *NOGRP*6HPNAM(60)»6PPOCX(611 t 
OHPCHK  (Ml  .GROUPS  (12*1 
rOMMQN/FSL/rFAC.TOTMS»,SEPHSPiPRCKEY.fPIFEY.INCFET» 

INCvECnm  .ICOUNT.StTwGT.EVALHF  noo)  .FETvCA(30) 
.NOFfT<.,VA»S2A.COHHAS.OIAPA»w6MSU.HESTVC  (10)  .OIVSIZ 
.ST aTK  T . AHRESn. AORtSP. AOPESF  f AOPSh] * A0RSH2 
INTEGER  *nRFSO,AOWESP.Af)RESE.AOBSHl»AORSM2.STATKy 
nOUPLE  PRECISION  CE AC . TOTmSR.SEPmSR 

nOltPLE  PPFC!‘-ION  C0V^T?(  I ) ,AVEMT2(1 1 ,S2m 
nOiiRI.E  PRECISION  niVTAbd)  .TMSR.OUMID.DM 

integer  CR|»FY 

niMENSlUN  COVMTX(l),  AVEMTX(l).  WEIGHTU). 

tsn  1 .wBKRYd) 

IPART«-1 

DIMENSION  TVECOO)  ,NHEST(30)  .TRYVECOO) 

SAVE  THE  VAll'E  OF  NOEETA 
NESAVEsN'OFETA 
IF (NOST, 01.0)60  TO  IS 
tF(U'CEtT.LE.n)GO  TO  15  \ 

no  10  l = l.p:rFET 
no  S Jr  1 .►.OFF  T? 

IF  (I^  CVK  d ) .eO.FFTVC2<  J)  )GO  TO  6 
CONTINUE 

WRITF(S.lun)  INCVECd) 

GO  TO  1 0 
NBSTrNHST*  1 
NpFST (Most ) =j 
continue 

SET  UP  VFCrOW  OF  features  to  try  with  NHEST 

TE(MSST.(5F.i  FSAVF  )GO  TO  SO 

SEPMSRr] .f*3S 

MTRYrO 

UO  Trl.  J0FET2 

TF(NHST.t-O.ri)G0  TO  24 

no  20  J=1,W-->ST 

TF  ( T .FO  ST  ( J)  )GO  TO  2S 

rOMT  iNiir 

NTRYrNTNY  * 1 

TRYVFC (MTRY) r I 

rONT  INUE 

TPv  FACh  FF.-dlMF  IN  TRVVEC  VlTM  THE  'REST*  SO  FAU  AND  KEEP 
The  one  xhICh  gives  maximum  SFPAmAHILITY  n'ASURE. 


xn 

IS 


40 


to 


MFbNM 
NOE  FT 
no  4 0 
IF  (NM 

no  11' 

TVFC  ( 

T VFC  ( 
CALL 
Cai  I 
CALL 

I 

IF  (SF 
«FFPr 
SFP.'S 
roNT  I 
MMSTr 
MRFST 
NO  TO 
MOFf  T 


ST.l 
4*  of 

Id' 
S T . t 
Jd  ' 
J)  s ‘. 
i.F  ) - 
nPHE 
(dST 
E VAt 

PMSl< 
TPrv 
wrTM 
NIIE 
NHSf 
(M  <S 
IS 

4=iE 


•E 
T< 
R ( 
A ( 
Sr> 

.1. 
I-  r 
SR 


T^Y 

I'lGO  10  JS 
'ST 
^ T ( J ) 

Y vE  r ( 

T vE'  r . 

(C)'/ 

( I VSR 
|>  E !f 
T.  I-'. 

( I ) 


90 

\> 

30 

40 


I ) 

I NF  ) 

T « . AVI  HI  X .S.f OVMT2, A VFHT2.S2.T VEC.DM. VRKWY.  I V»KS? 
.fOY*dX.AVEMTx.S.COVMT?.AvFMr2,S2,niVTAE). 

HT  dRAHl  .iiUM.OUM.taRoRY.  IHRKSZ! 

E-)GO  10  4 0 


♦ I 

T) rKEEP 

SA  vF 


WHROOOlO 
WHP00020 
WHR0OQ30 
WHROOOaO 
VHROOOSO 
WHR00060 
MHROOOTO 
vhROOOHO 
WhROO 
VHROO 
WHROO 
WHROO 
WHPOO 
WHROO 
COHOOOIO 
COM00020 
COM00030 
COM00040 
COmOOOSO 
CUM00060 
WHP00220 
WMR00230 
WHR00240 
WHR00250 
WHR00260 
WHE!00270 
WHR002P0 
UHR00290 
WHROOjOO 
WHR00310 
WHR00320 
WHR0033Q 
WHR00340 
UHR003S0 
VMR00360 
WHR00370 
WHW00380 
WHR00390 
WhROOAOO 
WHR00410 
WMR00420 
WMR00430 
WHR00440 
hhROOaSO 
WHR00460 
VHP00470 
VHR004HO 
4HR004V0 
WHROObOO 
WMMOOSIO 
WHR00S20 
WHR00S30 
WMR00540 
WHR005SO 
WMROOShO 
WHR00570 
WEIR00580 
WMR00S90 
BHR00600 
WHPOOCilO 
v»iR006?0 
WHP00630 
RHhOOGAI' 
WE'kOOnSO 
V EiR  0 06S0 
••mP  OOo  70 
w)iP00h“0 
whPOONRO 
) Whh00700 
4HR007 I 0 
RMRn0720 
WHHnn730 
>VHWa0740 
wEiwi:(,'7S0 
WMR  1)0  7mo 
wh«(:0770 
WMROO  7«0 
VM-ooyvo 
4 MW  0 OP  0 0 


FILPt  WHPPLC 


00  <S0  T»1.N0FET4 
K=NHF«iT(l) 

TVPCU  > -K 

Art  FETVC4«I)=rETVC?(K) 

r» 

C»  COMPUTE  INTFRCLASS  MEASURES  FOR  FEATURES  CHOSEN. 

C* 

CALL  OPOER(TVf C.N0FET4) 

CALL  GTSTAT(COVMTX,AVEMTX.S.COVMT2,AVEMT2.S2tTVEC,DUM.WRKRY, 

* IWRKS7) 

CALL  FVALSP(SKPMS«,C0VMTX.AVEMTX«S*C0VMT2.AVEMT2.S2f01VTAB, 

• Wf  lr,hT.lPART.DUM,OUM.WHK«Y»lWRKSZ) 

IF(CRIKFY.NF.  nwETURN 

CALL  OtVRGl (C0VMT2.VAPS24,AVEMT2*0IVTA8.N0CLS2* 

• NOr FTAiWRKRY. IWRKS2) 

RETURN 

100  F0RM/iT(»  the  I • UDE  REQUEST  FOR  FEATURE*. 14. 

* * IS  NOT  A LEoiTTH  FE  REQUEST  — IGNORED* ) 

FNO 


WHROOBIO 

WHROOt«20 

WHR00B30 

MHR00B40 

WHROOA50 

WHR00660 

WHR00870 

WHR008A0 

RHP00890 

WHR00900 

WHP00910 

WHR00920 

WHR00930 

WHR00940 

WHR00950 

WHR00960 

WHR00970 

WHR009BO 

WHR00990 


W&t  IS 

**  POOR  QUAIITY 


11.  CLASSIFY  PROCESSOR 


FILfi  CLSFr 


SUftROUTlNE  CLSFY( ARRAY t TOP) 
IMPLICIT  ; 

OIMENSION  array (3000) 


[NTE6FH  (A-HtO-H) 


CALL..  CALL  CLSFY  (ARRAY.TOP) 

ARGS..  ARRAY  - SFE  *MONTQR» 

TOP  - SFE  *MONTOR» 

REQUIRES.  COMMONS  /INF0RM/CLASS/GL0BAL/8MTRX/SCRACH/ 

ROUTINES  SETUP2  CLSFYl  CLSFY2 

PURPOSE..  COORDINATES  THE  VARIOUS  ROUTINES 
FOR  »CLASSIFICATION*  STEP 

RETURNS..  NONE 


INCLUDE  COMBKl.LIST 


C0MBK2.LIST 

C0MBK6.L1ST 


CSEND 


INCLUDE 

INCLUDE  

COMMON/1NFOHM/NOCL52.NOSUB2.NOFET2.VARSZ2.TOTVT2.NOFL02. 

* AVAP?,C0VAR2.CLSI02.SUBN02.SU8DS2.FL0SV2.VERTX2. 

* FETVC2(30)  ,SURVC?(7S)  .SUe<>TR(75)  .CLSVC2(60)  . 

* KERPTS (ftO) .N0GHP.GRPNAM(60) »GRPDEX(61) * 

6RPCHK (61) .GROUPS (12A) 

COMMON  /CLASS/  APRFLG.RMCOM0.BMFEAT.8MFLG.NOCAT.THIJ1.IDATA1. 

* NFILE.STATKY.CATNAM(60) . 

3 CLSSYM(60) .CONC60) .DET (60 ) .FLDESCiFLOINF (6) . 

4 KCLSNA (60) .NOCTCL (60) tSUBCAT (60) 

* »NOCHANfCHNVEC(30) 

ION  IS  USED  BY  THE  CLASSIFY  PROCESSOR.  IT  IS  IN  CORE 
THIS  PROCESSOR  IS, 

- SET  TO  THE  NUMBER  OF  APRIORI  VALUES  READ  IN  FROM 
INPUT  CARDS 

- NUMBER  OF  LINEAR  COMBINATIONS  IN  B-MATRIX 

- NUMBER  OF  CHANNELS  USED  IN  COMPUTING  THE  B-MATRIX 

- INDICATES  WHETHER  A B-MATRIX  HAS  BEEN  INPUT 

- NUMBER  OF  CATEGORIES 

- beginning  address  for  STORING  THE  CLASS-PAIR  THRES- 
HOLD TABLE 

- beginning  ADDRESS  FOR  STORING  THE  DATA 

- number  of  the  next  file  TO  BE  WRITTEN  ON  MAPTAP 

- FLAG  CONTROLLING  STATISTICS  PRINT  OUT 

- CONTAINS  the  CATEGOTY  NAMES 

- default  symbols  USED  IN  PRINTING  CLASSIFICATION 

- CONTAINS  The  subclass  CONSTANTS 

- CONTAINS  the  subclass  DETERMINANTS 

- FIFLO  name 

- CONTAINS  The  rectangular  COORDINATES  SURROUNDING 
THE  non-rectangle  field 

- CONTAINS  the  CLASS  NAMES  IN  THE  ORDER 
CATEGORY  CONTROL  CARO 

- NUMBER  OF  CLASSES  IN  EACH  CATEGORY 

- CONTAINS  The  CATEGORY  NUMBER  TO  WHICH  T.^E 
SUBCLASS  BELONGS 


c* 

c* 

CLASS  COM 

c» 

ONLY  WHEN 

c* 

APRFL6 

c* 

c* 

8MC0MB 

f • 

BHFEAT 

c* 

BMFLG 

c* 

NOCAT 

c* 

THIJI 

c* 

c* 

lOATAl 

c* 

NFILE 

c* 

STATKY 

c# 

catnam 

r* 

CLSSYM 

c* 

CON 

c» 

OET 

c* 

FLDESC 

c* 

FLDINF 

c* 

c* 

KCLSNA 

c» 

c» 

NOCTCL 

c* 

subcat 

c* 

c* 

CLSOOOlO 

CLS000|0 

8ti8S8l8 

[CLSOOOSO 

i8tl888)f 

CLS0008C 


00 


00 

8tl88 

CLSOO 
ICLSOO 
tCLSOO 
ICLSOO 
ICLSOO 
ICLSOO 
iCLSOO 
ICLSOO 
>iCLS0021O 
•!CLS002|o 
CLS00230 
CLS0024Q 

CLS00270 

-CLS002B0 

CLS00290 

CLS00300 

CLS003I0 

CLS00320 

CLS00330 

CLS00340 

CLS003S0 

CLS00360 

CLS00370 

CLS00380 

CLS00390 

CLS00400 

CLS00410 

CLS00420 

CLS00430 

CLS00440 

CLS00450 

CLS00460 

CLS00470 

CLS00480 

CLS00490 

CLS00500 

CLSOOSIO 

CLS0052C 


>00S3g 


CL* 

CL§0054( 
CL500550 


CLS00560 
CLS00570 
CLS00580 
CLS00S90 
CLS00600 
CLS006iO 
CLS00620 
CLS00630 
CLS00640 
CLS00650 
CLS00660 
CORRESPONDINCLS00670 
CLS00680 


MAP 


TAKEN  OFF  the 


COMMON/6LOBAL/HEAO(63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY. 

* HISFIL,hISKEY.TRFOHM.EWIPTP,ERPKEY»MAPUNT,NOFILE, 

* DRUMA0.0RMWDS,PAGSI7.DATFIL.STAF!L,ASAV,ASAVFL 

* .NHSTUN.mhSTFI.SCTRUN.MAPFIL 

* ,DOTUNT.OOTFIL,NCHPAS,TRNSFL,BMTRFL»HISTFL»PCHUNT, 

* crount.prtunt.wandio 


CLS00690 

CLS00700 

CLS00710 

CLS00720 

CL500730 

CLSOOTAO 

CLS00750 

CLS00760 


/J7 


oo»-o  r»  o or»( 


FlLe 


CLSFY 


COMMON  /BMTRX/BMATMX(450)  CLS00770 

CLSOOfaO 

................................. .....................clS0079< 

CLSOOBOj 

DIMENSION  KATNO(60)  CLSOoSil 

CLS00B30 

CLSOOBAQ 

................... ... — ... CLSOOaSO 

CLS00860 

REAL  APRIOR(60)  ClIoOBbS 

CLS00890 

............. ... ........ {|.SOQ905 

CLSOO9IO 

COMMON  /SCRACH/  I0ATAO2S00)  CLS00920 

CLS00930 

... ... CLS009AO 

CLS009S0 

NOTE*  THE  IDATA  ARRAY  IS  USED  EXTENSIVELY  AS  A SCRATCH  CLS00960 

area  in  CLSFYU^FOR  output  of  CLASS-PAIR  THRESHOLDS  IN  CLS00970 

CLASSIFIED  IN  CLSF  CONTEX)  * INPUT  OF  SCAN  LINE  TO  BE  CLS0099( 


FLDFLG.O 

CALL  SETUP2( ARRAY. T0PfFL0FL6tAPRI0R*BMATRX.KATN0» 

IF  (FLDFL6.EQ.1)  60  TO  10 

CALL  CLSFYI (ARRAY(COVAR?) . ARRAY ( AVAR2) , ARRAY (FL0SV2) t 

♦ ARRAY(CLSI02) .APRI0R.8M4TRX.ARRAY<VERTX2) .ARRAY (SUB0S2) . 

• ARRAY (SU8N02) .ARRAY (C0VAR2) .ARRAY (AVAR2) .KATNO) 


CALL  CLSFY2(ARRAY(C0VAR2I .ARRAY(AVAR2) .ARRAY (FLOSVJ 
» ARRAY (CLSI02) .ARRAY (SU80S2) .ARRAY (SUBNO. 

END  FILE  MAPTAP 


I. 


CLSOIOSS 
CLSOIOAO 
CLS01050 


WRITE  (6.20) 

20  format (////  IX.**** 
RETURN 
END 


SCLASSIFY  - COMPLETED  ***•  ////) 


CLSO 
CLSO 
CLSO 
CLSO 
CLSO 

). KATNO. 6MATRX)CLS0l 
CLSOl 
CLSOl 
CLSO 
CLSO 
CLSO 
CLSO 
CLSO 


CLS01190 


FILE  CAT6RY 


SUBROUTINE  CATGRT (NCHAN.NPTStAVEtCORt IRfVRtBHATft* 10ATA»NLINE« 
• VERTCS»NVtPTSTHS) 


C 

C 


NCHAN 

NPTS 

AVE 

VR 

CON 

bmatr 

lOATA 

NLINE 

VERTCS 

NV 


NO,  OF  CHANNELS 

NO,  OF  PTS.  IN  RECTANGLE  FIELD 
means  ARRAY 

covariance  array 

CLASSIFIEO  DATA 

CORRESPONDING  PDFS  OF  IR  ARRAY 

suhclass  constants 

8-TRANSFORMATION  matrix*  if  available 
SCAN  LINE  OF  DATA  TO  BE  CLASSIFIEO 
LINE  NUMBER  CORRESPONDING  TO  DATA  TAPE 
VERTICES  OF  FIELD  TO  BE  CLASSIFIED 
NO,  OF  VERTICES 


CSEND 


PURPOSE  I EACH  PIXEL  IS  ASSIGNED  TO  A C^'^c^oRY,  THEN  ASSIGNED 
TO  A SUBCLASS  WITHIN  THAT  CHOSEN  CATEGORY,  ON  THE 
MAPTAP  THE  CHOSEN  SUBCLASS  NUMBER  AND  ITS  CORRESPOND- 
ING PDF  IS  OUTPUT. 

RETURNS  i IR  ARRAY  RETURNS  THE  SUBCLASS  NUMBER  EACH  PIXEL  WAS 
ASSIGNED  TO 

t VR  ARRAY  RETURNS  THE  CORRESPONDING  PDF 

IMPLICIT  INTEGER  (A-2) 

LOGICAL  BMFLAG*KDl 

DIMENSION  IDATAd  ) ,IRI  1000)  .FUP2)  ,SUBNUM(60)  *VERTCS(1) 

REAL  VR(IOOO)  *AVE(1)  .CORU)  ,0ATA(30)  *DM(30)  * 

• 8MftTR(8MCnMB,8MEEAT) ,S*P«60) *TF*PK 
REAL  FOATA,  SUM 

real  TEmAX (frO) ,E.C0N 
INCLUDE  COmbkI.LIST 
include  COMBKP.LIST 

COMMON/ INF0»M/N0CI.S2.N0SUB2.N0FET2,VARSZ2*T0TVT2*N0FLD2* 

• AVAR2,C0VAR2*CLSI02*SUbN02»Sl)B0S2.FL0SV2,VERTX2t 

• FETVC2(30) *SUMVC2(75) ,SUbPTR(75) ,CLSVC2(60) . 

• KEPPTS(60) ,NOGRP,6RPNAM(60) *GRP0EX(61) ♦ 

• GRPCHK (61) .GROUPS (12A) 

COMMON  /CLASS/  APwFLG.fc!MCOMB.BMFEAT.faMFLG.NOCAT*THlJl ♦ IDATAl . 

• NFILE,STATKY,CATNAM(60) » 

3 CLSSYM(hC) ,CON(60) *DET<60) .FL0ESC,FL0INF<6> . 

4 KCLSMA(bO) .NOCTCL(bO) .SUBCAT(60) 

• .NOCHAN. CHNVECOO) 


c 

c 


10 

.20 


C 

C 

C 


equivalence  (FLDINF(I) .LINSTR)  , 
S (FL0IMF(.3)  .LININC)  » 
* (FL0InF(5) .SAMENU) » 


BMFLAG  = BMFLG  ,GT.  0 
IF  (BMFLAG)  GO  TO  10 
NF  = NCHAN 
GO  TO  20 
NF  = BMCOHB 
KDl  = NF  .EO.  1 


(FLDINF(2)  -,LINEND)  * 
(FLDINF(4) .SAMSTR)  « 
(FL0INF(6) .SAMINC) 


ZERO  OUT  IR  AND  VR 

DO  S5  K=1.NPTS 
IR(K)  = 0 
SS  VR(K)  = 0,0 

CALI  FOLINT (VERTCS. NV.FL. NLINE. IPTS.NI) 

DO  350  JJ=1.NI,2 

IB  = (FLUJ)  - SAMSTR)  / SAMINC  ♦ 1 

IE  = (EL(JJ*n  - SAMSTR)  / SAMINC  ♦ 1 

IE  (MOOISAMST'’, SAMINC)  ,NE.  MOD  (FL  (JJ)  .SAMINC) ) IB 


18  « 1 


CATOOOtO 

CATOOOlO 

CAT00030 

■CAT00040 

CATOOOSO 

CAT00060 

CATC0070 

CAT00080 

CAT00090 


CATOO 
CATOO 
CATOO 

8H81 

CATOO] 
CATOOi.^ 
CATOOiiO 
CAT00220 
CAT00230 
CAT00240 
CAT00250 
CAT00260 
CAT00270 
CAT00280 
-CAT00290 
CAT00300 

CAT00330 

CAT00340 

CAT00350 

CAT00360 

CAT00370 

CAT00380 

CAT00390 

CAT00400 

CAT00410 

CAT00420 

CAT00430 

CAT0044Q 

CAT00450 

CAT00460 

CAT00470 

CAT00480 

CAT00490 

CATOOSOO 

CATOOSIO 

CAT00520 

CAT00530 

CAT00540 

CATOOSSO 

CAT00S60 

CAT00S70 

CAT00580 

CAT00590 

CAT00600 

CATOOblO 

CAT00620 

CAT00630 

CAT00640 

CAT00650 

CAT00660 

CM00670 

CAT00680 

CAT00690 

CAT00700 

CAT00710 

CAT00720 

CAT00730 


onoo  oooo  o ono  o o ooon 


file  CATGRY 


2.1 


41 


F (Ifl  ,GT.  IF  ) 

0 250  II^IH.IE 


GO  TO  350 


g FLOAT  DATA  SAMPLEf  AND  APPLY  THE  B-MATRIX.  IF  AVAILABLE 


.IF  (BMFiAG)  60  TO  30 
00  25  I=1,NCMAN 
lOUM  a NPTS  * (I  - 1)  ♦ II 
OATAd)  = IDATA(IDUM) 

GO  TO  45 

DO  35  lal.BMCOMS 

SUM  s 0.0 

DO  40  K=1.NCHAN 

INDUM  = NPTS  * {K  - 1)  * I 

FDATA  = IOATA(INOUM) 

SUM  * SUM  ♦ BMATR(I.K)  * FDATA 

OATA(I)  = SUM 

CONTINUE 

DO  65  LL=l»NOCAT 
P(LL)  = 0.0 


25 


30 


40 

35 

45 

<0 

60 

65 


C 

C 


130 


140 


145 

146 


IRM  a - NF 
LC  = 0 

DO  130  KL=1*N0CAT 
TFMAX(KL)  = -1.0E35 


CAT00740 

CAT00750 

CAT00780 

CAT00790 

CATooaoo 

CATOOalO 

CAT00820 


DO  150  KK=1.N0SUB2 
IBM  = IBM  ♦ NF 
KM  = ISM  ♦ 1 
S = DATA(l)  - AVE(KM) 

DM(l)  = S 
LC  = LC  ♦ 1 

TF  a CON(KK)  ♦ (S*S)  / COR(LC) 

IF  (KUl)  GO  TO  146 

LOOP  FOR  COMPUTING  THE  KD-TH  ELEMENT  OF  Y ( L**~l  * (X-M) ) , WHICH 

IS  STORED  !N  S 

DO  145  K0=2.NF 

KM  = IHM  ♦ KD 

S s DATA(KD)  - AVE<KM) 

J1  = KD  - 1 
DO  140  LD=1.JI 
LC  a LC  ♦ 1 
S a s - COW(LC) 


OM(LU) 


OM(KO)  a s 


LC  a LC  ♦ 1 
COMPUTE. THE  KO-TH  TERM  IN  :i/2*Y  * D**-l 


* Y 

a 1/2  * <X-M)  * K**-l  * 


(X-M) 


148 


150 


TF  a TF  ♦ ( S*S  )/CO«(LC) 

TF  a -.5  * TF 
SUM  THE  EXP(P(KK)) 

IF  PDF  IS  smaller  than  -88.  00  NOT  EXP. 

IF  ( TF  .LE.  -84)  E a 0.0 

IF  ( TF  .LE,  -88)  GO  TO  148 

E a EXP(TF) 

CONTINUE 

CTGOPY  - SUHCAT(KK) 

P(CTGORV)  a E ♦ P(CTGORY) 

find  max.' value  OP  PDF  OVER  ALL  SUBCLASSES  WITHIN  A CATEGORY 
AND  SAVE  THE  SUBCLASS  NUMBER  OF  THE  LARGEST  PDF 

IF  (TF  ,LF.  TFMAX(CTGORY) ) GO  TO  150 
TFMAX  (CT(jnPY)  a TF 
SUBNUM (CTGORY)  = KK 
CONTINUE 


CAT00850 
CAT00860 
CAT00870 
CATOOBflO 
CAT00890 
CAT00900 
CAT009l0 
CAT00920 
CAT00930 
CAT00940 
CAT00950 
CAT00560 
CAT00970 
CAT00980 
CAT00990 
CATOIOOO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 

CAT  0 1 . V 
CAT01160 
CATO 
CATO 
CATO 
CATO 
CATO 
CATO 

CATO 

CAT01240 
CAT01250 
CAT01260 
CAT01270 
CAT01280 
CAT01290 
CATO}300 
CAT01310 
CAT01320 
CAT01330 
•^^^01340 
CATO  1 350 
CAT01360 
CAT01370 
CAT0j3a0 
CAT01390 
CAT01400 
C4T01410 
CATO  1420 
CAT01430 
CAT01440 
CAT01450 
CAT01460 
CAT01470 
CAT01480 
CAT01490 
CAT01500 
CAT01510 


J^'4 

/ ‘/4> 


OOOO  00( 


FILE  CATGRV 


FIND  TH£  MAX,  CATEGORY  PDF 


<THIS  PDF  IS  THE  SUMMATION  OF  ALt 
THE  PDF'S  OF  THE  SUBCLASS  WITHIN 
THE  CATEGORY) 


l7?' 


175 


rc : 

CONTINUE 


LLi 


< P(LL| 


>l«NOCAT 
,LE,  PK) 


GO  TO  175 


ALL  OF  THE  SUBCLASS  PDF'S  WERF  TOO  SMALL 
THIS  PIXEL  WILL  NOT  BE  CLASSIFIED, 


TO  EXP,.  THEREFORE 


IF  <PK  ,NE,  0.0)  GO  TO  180 

'(H)  » ^ 


VR(Il)  » 0.0 
PTSTHS  a PT5THS  ♦ 1 
GO  TO  250 
leO  CONTINUE 

STORE  THE  LARGEST  SUBCLASS  PDF  AND  SUBCLASS  NO.  OF  THE  CATEGORY 
WITH  THE  MAX.  PDF 

IR(Il)  a SUBNUM(IC) 

vRnn  a tf(-ax(ic» 

250  CONTINUE 
350  CONTINUE 
RETURN 
END 


;ato 


III 


m 


ilS 

590 

hi 

620 

630 

6A0 

650 

660 

lf>70 

- ..680 
CAIQ1690 

0 
0 


AT0J750 
" 760 

AT01790 


800 


ATOieiO 
CAT01820 
CAT01830 


/¥/ 


r>r»r>  r»r^r>  ,-)on  r>r>o  r»  no  or» 


filf:  CATSCN 


FUNCTION  CATSCN (CARO«KCLSNAtCATNMC«KKtNOCLSS»NOCAT> 

IMPLICIT  INTFSffi  lA-Z) 

OIMgNsiON  KCLSNA  ( ] > «CARO(f>Z>  • IBUFF  (6) 

CATSCN  SCANS  THF  CATEOORY  CARO  FROM  CLASSIFY  AND  STORES  THE 
CATEGORY  NAME  IN  CATNAM  AND  STORE  THE  CLASS  NAMES  IN  KCLSNA 

DATA  RLANK/*  •/,SLASH/»7»/*STAR/***/»C0MMA/*» •/ 
lOPICAL*!  LCHAR(a> ,LLCHAR(4) 

DIMENSION  ICHAR(I)  .IlCHAHn) 

EQUIVALENCE.  (LCHAR  ( I ) ♦ ICMAR  ( I ) ) » (LLCHAR ( 1 ) » I ICMAR « I ) ) 

K « 1 
rOL  a 0 
KK  a KK  ♦ 1 


10 


NXTCHR(CARO»COLl 
,F'J.  RLANK)GO_tO  110 


J 

IF(J 

IF( J.EQ.C0MMA)60  TO  10 
IF<J.F0.SLASH)60  TO  10 
IF(J.EQ.STAR>GO  TO  100 

PICK  characters  OFF  CARD  ONE  AT  A TIME 
LL  a 1 


?0 

10 


3R 

40 

SO 

SO 


70 


ai) 


100 


SOO 

SSO 


110 


CATOOOlO 
CATOOOfO 
CAT00030 
CAT00040 
-CATOOOSO 
CATOOOAO 
CAT00070 
CATOOOAO 
CAT00090 
•CATOOlOO 
CATOOllO 
CAT00120 
CAT00130 
CAT00140 
CATooiso 
CAT00160 
CAT00170 
CATOOISO 
CAT00190 
CAT00200 
CAT00210 
CAT00220 
CAT00210 
CAT002AO 
CATOOISO 
CAT00260 
>70 


J2  a CAr6(C0L» 

CAT002SQ 

Yf(J2.FO.SLaSH)G0  TO  30 

CAT00290 

TF(J2.F).STAM)60  TO  30 

CAT00300 

IF(J?.FQ.C0MMA)G0  TO  30 

CAT00310 

1F(J2.F0.RLANK)G0  TO  20 

CAT00320 

IBUFF (LL)  a J2 

CAT00330 

LL  a LL  ♦ 1 

CAT00340 

COL  a rOL  ♦ 1 

CAT00350 

rONTINIIF 

CAT00360 

roL  a roc  - 1 

CAT00370 

TF  (LL  .Nt.  7)  60  TO  35 

CAT003A0 

r-0  TO  50 

CAT00390 

CAT00400 

no  40  jjaLLtS 

CAT00410 

TPIIFF(JJ)  a plank 

CAT00420 

CAT00430 

rONTINUF 

CAT00440 

00  SO  Ial,4 

CAT00450 

HrHAP(J)aIflUFF(I) 

CAT00460 

LCMaR(I)=lLChAR(1) 

CAT00470 

WROlalCMARd) 

CAT004RO 

CAT00490 

GO  TO  (70«fl0) »K 

CAT00500 

CATOOSIO 

WROl  CONTAINS  CATEGORY  NAME 

CATn0520 

CAT00S30 

CATNi'E  a .,H01 

CAT00540 

K a 2 

CAT00550 

GO  TO  10 

CAT00S60 

CAT00570 

WROl  CONTAINS  CLASS  NAME 

CAT005S0 

CAT00590 

KCLS^A(KK)  = WPDl 

CATA0600 

MOCLSS  a ^•O^LSS  ♦ 1 

CAT00610 

GO  TO  P 

CAT00620 

CAT00630 

NEXT  CARO  IS  A CONTINUATION  CARO 

CAT00640 

CAT006S0 

PEAD(21 .SOO)CAWO 

CATOOhftO 

roi.  a ft 

CAT00670 

WRITE (h,SSO)CAR0 

CAT006RO 

FORMAT  ( 1 OX  t(S2AU 

CAT006RO 

FORMAT!  TIS.  62A1) 

CAT00700 

GO  TO  1ft 

CAT00710 

CAT00720 

FIMISHEO  SCANNING  CARD 

CAT00730 

CAT00740 

KK  a KK  - 1 

CAT007S0 

CATSCN  a KK 

CAT0C760 

CAT00770 

rftuwn 

CAT007R0 

FNO 

CAT00790 

FlLCt  CLSFYl 


C 

C 

cl 


I 

il 


C 

c 

Cl 

Cl 

ci 

c| 

Cl 

CI 

‘cl 


CI 


c 

ci 

81 

8 

81 

81 

CI 

CI- 

Cl- 


c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  CLSFVl (COVMTX, AVEMTXtFLDMTX.CLSMTX.APRIORt 
• RMATR«VCRTEX«S0BOCS*5UttNO«COVNCM*AVCNEW«KATNO) 

IMPLICIT  INTEGER  (A-M,0-Z) 


CALL...  CALL  CLSFYKCOVMTX.AVEHTX.FLDHTX.RUNMTXtCLSMTXtAPRIOR^ 

bmatr»covnew»avenew  ) 


88188818 

CLS00030 

CLfOOOAO 

CLSOOOSO 

.•88188888 

•ICLSOOOGO 

•88188?” 

-CU 


ARCS...  COVHTX 


LOCATION  OF  COVARIANCE  MATRICES  ( SVMETTRIC 
STOKA6E  > FOR  N0CLS2  TRAINING  CLASSES. 


AVEMTX  I LOCATION  OF  NOCL* 
I N0FET2  MEANS  PI 


g training  CLASS  MEAN  VECTORS 


FLOMTX  i LOCATION  OF  TRAINING  FIELD (S)  INFORMATION 
CLSMTX  t LOCATION  OF  NAME  FOR  EACH  CLASS 


APRIOR  t 


LOCATION  OF  APRIORI 
EACH  CLASS 


PROBABILITY  VALUES  FOR 


VERTFX  : LOCATION  OF  VERTICES  OF  SAVED  TRAINING  FIELDS 
SUBDES  : LOCATION  OF  SUBCLASS  NAMES 


SUBNO  t LOCATION  OF  ARRAY  CONTAINING  NO. 
EACH  CLASS 

COVNEW  1 LOCATION  USED  TO  STORE 
COVARIANCE  MATRICES. 


OF  SUBCLASSES  IN 
• *8  • '-TRANSFORMED 


CONTINUE 


TO  STORE  THE  "B"-TRAN5F0PMEn 


FATNO 


AVENEW  : LOCATION  USED 
MEAN  VICTORS. 

BMATR  : LOCATION  OF  THE  "R"-TRANSF0RMATI0N  MATRIX. 

IF  AVATlABLE.  for  application  to  THE  CLASS 
MEANS  AND  COVARIANCE  MATRICES. 

CATEGORY  - CLASS  CORRESPONDENCE 


PURPOSE... 


IF  AVAILABLE*  THE  "B"-TRANSF0RMATI0N  MATRIX 


AND  COVARIANCE  MATRICES. 

. 8EO)  CHOLESKY 

covariance  matrices.  PROVIDES  THE 


FACTORIZATION  OF 
•CONSTANT'  OF 


the 


TO  the  SUBC)  ASS  MEAN  VECTORS 

OBTAINS  the  (MODIFIED) 

SUBCLASS  ■ ::  “ ~ 

ThF  probability  density  FUNCTION  AND  DETERMINANT  FOR 
FACH  subclass.  AND  OBTAINS  THE  SUBCLASS-RAIR  THRESHOLDS  FOR 

UBF  BY  SUBR.  CONTEX  IN  CL A«iSIFICAT10N  OF  INPUT  SCAN 
LINES.  PUBLISHES  AND  OUTPUTS  ON  MAPTAP  THE  TRAINING 
FIELrHS)  information  AND  THE  STATISTICS  FOR  EACH  OF 
TRAINING  CLASSES. 

returns... CHOLFSKY  FACTORIZATION  OF  THE  INPUT  COVARIANCE 
(AFTER  'B'-TRANSFORMATION*.  IF  APPLICABLE).  SUflCLASSPAIR 
THRESHOLDS.  AND  SUBCLASS  STATISTICS  OUTPUT  ON  MAPTAP. 

CONTINUE 


CLS00220 
CLS00230 
CLS002A0 
CLS00250 
CLS00260 
CLS00270 
CLS002B0 
CLS00290 
CLS00300 
CLSOoSlO 
CLS0O320 
CLS00330 
CLS003A0 
CLS003S0 
CLS003GO 
CLS00370 
CLS003B0 
CLS00390 
CLSOOAnO 
CLSOOAlO 
ICLS00A20 
CLS00430 
ICLSOOAAO 
CLS004S0 
CLS00460 
CLS00470 
CLS004A0 
IS  APPLIEOCLSOO490 
CLSOOBOO 


INCLUDE  COMokI.LIST 


INCLUDE  COM«k?.LIST 

common/ I NFORM/NOCI.S2. NDSUB?. NOF ET2. VARSZ2. TOT VT2.NOFLD2. 

• AVAW2.C0VAR?,CLSID2,SUBN02.SUBDS2.FL0SV2.VERTX2. 

• FFIVC2O0)  .SUhVC2(75)  .SUBPTR(7S)  .CLSVC2(60)  . 


CLSOOSIO 
CLS00520 
CLS00530 
CLS00S40 
CLS005S0 
CLS005G0 
CLS00570 
THE  CLSOOSflO 
CLS00S9O 
ICLS00600 
matrices  CLS00610 
CLS00620 
CLS00630 
CLS00640 
ICLS006S0 

ICLS00660 

ICLS00670 

CLS0O6BO 

CLS00690 

CLS00700 

CLS00710 

CLS00720 

CLS00730 

CLS00740 

CLS007S0 
CLS007F.O 
CLS00770 
CLS00780 
CLS00790 


or>o  nr>r>r»onooor>oor>  o oooooo  o no  o o o oooo 


FlLFt  aSFYl 


• KFPPTS(60) «NOGRP*GHPNAH(60) «6PP0CX  <6l>  * 

• GR<»CMK«Gl).fiR0UPS(l24) 

COMMON  /CLASS/  APRFLO.BMCOM0*9PF£AT,PMFL6»NOCATtTMlJI*lDATAl» 

• NFIL£»STATKY»CATNAM(A0» , 

3 CLSSYM(AO) «CONI60) •DffT(60) .FLOCSCtFLOINF (6) « 

A KCLSNA(60) «N0CTCL(60) •SUBCATI60) 

,N0CHAN*CHNvIC(30) 


COMMON/GLOB AL/HF AO (63) ♦MAPTAPiOATaPF»SAVTaP»BMFILE«BMKEY* 

hi5fil»hiskey«trform,eSiptp.eppkey*mapunt»no( 

0RUMA0f0RM40SiPAGSTz*0ArFIL«STAFlLf ASAViASAVFL 


^SENO 


.nmstun.nhstfi.sctrun.mapfjl 

.OOTUNT .OOTFIL .NCMPaS. TRNSFL •BMTRFL .MISTFL  f PCMUNT. 
CROUNTfPRTUNTtRANOlO 


peal  CON»OET,COVMTX  <VAM$Z?.N0SUB2) 

REAL  AVEMTX (NOFETZtNOSUBS) «APR10R ( 1 ) «VEC (30) t BXKXBT (120) 
REAL  SUM*SUMTRtOUM(60) •RERR0R(60) «APR.COV (46S) 

REAL  RELERR 


COMMON  /SCRACH/SCRl (2000) «SCR2(10500) 


EQUIVALENCE  ( VEC(1)«  SCRKD)  • ( BXKXRT(l)t  SCRK31)  ) * 

1 ( SUM.  SCRKISI)  ) * ( SUMTR.  SCRK1S2)  ) 

2 . ( OUM(l),  SCRK153)).  ( APR.  SC«1  (215)  ) 

3 . (RFRROH ( 1) ,SCH1 (216) ) . (COV( 1 ) .SCRl (2fl0) ) 

niMFNSTON  CI.SMTX  (1  ) .FLDMTX  (4.N0FL02)  .SUBNO  ( 1 ) .SUBDES  ( 1 ) • 

• VERTEX(2.TOTVT2) .KATNO(l) 

DATA  0COTwO/'?»/.BCDFO«/»4»/.DASH/» »/ 

OATA  LPRN/i ( •/ 


REAL  BMATR(BMCOMR.BMFEAT) 

PEAL  AVENE4(BMC0MB.8MFEAT) .COvNEW(0MFL6.NOSUB2) 


INCLUOF  COMHK6.LIST 


HEADER  RECOPf)  NO.  2 FOR  MAPTaP 

TF  (NO(^JT  .GT.  0)  NOCATl  s NOCAT 
fF  ( NOCAT  .LE.  0 ) NOCATl  s N0CLS2 

WRITE (MAPTAP)  (CATNAM(I) . 1 = 1 .NOCATl ) . (CLSMTX  < I) . I = 1 .N0CL52) . 

1 (SUHNO(I)  .I*1.N0CLS2)  . (SUHDF.S(I)  .I=1.N0SUP2)  . 

2 ( (ELDMTX(I.J) .1=1.4) . J=1 .NOFLO?) . (( VERTEX ( I . J) .1  = 1.2) 

3 J»1 .T0TVT2) . (SUBCAK I) .1=1 .NOSUB2) . (CLSVC2( I) . 

4 I=1.N0SUB2) . (KATNO(I) .I=1.N0CLS2) . (KEPPTS(I) 

5 I«l.NOSUB2) 

WRITE  OUT  TRAINING  FIELD  INFORMATION 


CLS0O600 

cLSooaio 

CLS00R20 

CLS00B30 

CLS00840 

CLSO0B50 

CLS00860 

CLS00B70 

CLS00B80 

CLS00890 

CLS00900 

CLS00910 

CLS00920 

CL500930 

CLS00940 

CLS00950 

-CLS00960 

CLS00970 

CLS009A0 

CLS00990 

CLSOIOOO 

CLSoiOlO 

CLS01020 

-CLS01050 
CLSOiONO 
CLS01070 
CLS01080 
-CLS01090 
CLSOJ 
CLSoi 
CLSOl. 
CLSOltSO 
CLSOl 140 
CLS01150 
CLSOlIftO 
CLS01170 
CLSOl lAO 
-CLSOl IRO 
CLS01200 
CLS0I210 
CLS01220 
CLS01230 
CLS01240 
CLS01250 

-min 

CLS012A0 
CLS01290 
CLS01300 
CLS01310 
CLS0l320 
CLS01330 
CLS01340 
CLSOl 3S0 
CLS013f.0 
-CLS01370 
CLS013A0 
CLS013R0 
CLS01400 
CLS01410 
CLS01420 
CLS01430 
CLS01440 
CLS014S0 
CLS014NO 
CLS01470 
CLSPUflO 
CLS01490 
CLSOISOO 
CLSOISIO 
.CL501S20 
CLS01S30 
.CLS01S40 
CLSOIS50 
Cl SOISNO 
CLS01S70 
-CLSOlSbO 


no  nnnn 


FIUEt  CLSFVl 


6^ 

10 


CLASSIFICATION  STUOY  •••  MAPTAP  FILE  »»SX.  IZ/ZIcllloiloO 
CALL  WPTFL0(FL0MTXtVERTCX«N6FL02tltCLSNTX*SUB0ES)  CL$016lO 

PUBLISH  THE  CLASSES  AND  CHANNELS  (WITH  SPECTRAL  SAND)  TO  BE 
CONSIDEHEO  IN  CLASSIFICATION. 


?0 


10 

«0 

SO 

60 


661  • 
60? 
601 


604 

605 

606 

60T 

610 


611 

70 


CLS01690 

subclasses  CONSIOEREO<iT90« 'CHANNELS  CONSIOfREQ*  CLSOiTOO 
Zt'SUBCLASS' tT4S*'A  PRIOR* »TB6« 'TRAINING  RCCOGNCLS0i7|0 

CLSOr 
CLSOi 
CLSoi 
CLSof 


WRITE(6*HEA0) 

WR1TE(6.6S»  NFILE 
WRITF(6.?0) 

F0OMaT(  ////T27.'_ 

•//T21 , tSYMBOL' *T32 
•ITIOM'I 

> NOSU^^^  N0FET2  ) II  ■ N0FET2 
no  30  l«l,II 

YRITF  (6.401 

IF  (I  .LF.  NOSUB?)  WRITE(6,50)CLSSVM(I) ,SURDES(1) .APRIOR(I) 
IF  (1  .lE.  N0FET2)  WR1TE(6.60)FETVC2(1> .CHNVEC(I) 

continue 

FOPMATC  •) 

F0PMAT{'*'.T?3.A1.T33.A4.T45.F7.A) 

FOPHATC* '.191.12,1103.  12) 

SAVE  AND  PUBLISH  THE  MEAN  AND  COVARIANCE 


IF  P-MATRIX  IS  AVAILABLE.  TRANSFORM  THE  COVARIANCE  MATRIX  AND 
MFAN  VECTOR 

TEHPF?  » N0FFT2 
IF(  hMFlG  .LF.  0)  GO  TO  611 
no  61  n NCl.Ssl  .N0SUB2 
no  60=  Mal.MHCOHB 
BRWIO?  = ( W • (R-1) 

00  601  r»i,« 

1 a RHM102  ♦ C 
SUMTW  a 0.0 

no  6f»?  J»|,N0FET2 

SUH  a 0.0 

no  6C1  k*1.n0FET2 

II  a ( 6 • <K-1)  )/2 

1F(  J .GT.  K)  IIs  ( 


)/2 


(J-1)  )/2  ♦ K 
COVMTX(II.NCLS) 
• SUM 


J)  • AVEMTX(J.NCLS) 


SUM  s SUM  ♦ BMATR(R.K) 

SUMTH  a SUMTR  ♦ BM4TR(C.J) 

BXKXBT(I)  a SUMTR 
SUM  s 0,0 

no  604  Jal.NOFFT? 

SUM  a SUM  ♦ HM4Tk(R, 

VFr(R)  a SUM 
CONTINUE 
no  606  Jal.I 
C0VNPW(J,NCLS»  a PXKXBT(J) 
no  607  Jal.HKCOMB 
AVFNFW(J.NCLS)  a VEC(J) 

CONTINUF 
V4RS7?  a HMPlG 
NOFFT?  a HMCOM9 

continue 
no  TO  no 
CONTINUE 

OBTAIN  TMF  SURCLaSS-PAIR  THRESHOLDS.  FOR  USE  BY  CLSFY2/C0NTEX 


TF  (NOCAT  .RT.  0)  60  TO  612 

NPLl  = NOFET?  ♦ 1 

CALL  THHFSH(NnSue?,N0FET2,NPLl .APRIOR.AVFMTX.COVMTX.OET.VARS72. 

1 SCR?(1 ) .SCR?(901)  *SCR2n801)  .SCR2  (163 1 ) .SCR?  ( 1R61 ) • 

2 SCR2 (2791 ) ,SCH1 (THlJl) ) 

61?  CONTINUF 

NOFFT?  a TEMRF? 

RFTURN 

no  III  = 0 


CLS0172Q 
730 
740 
-750 
LS01760 
:LS01770 
SlS017B0 
:LS01790 

:lso{8oo 

CLSOIAIO 
;L5018?0 
cL|01830 
:lsoi84o 
8f  * 

11 
880 
890 
900 
910 

920 

CLS01930 

CLS01940 

CLS019S0 

CLS01960 

CLS01970 

CLS01980 

CLS01990 

CLS02000 

CLS02010 

CLS02020 

CLS02030 

CLS02040 

CLS02050 

EhloiS^g 

CLS02080 

CLS02090 

CLS02100 

CLS02no 

CLS02120 

CLS02130 

CLS02140 

CLS02150 

CLS02160 

CLS02170 

CLS02180 

CLS02190 

CLS02200 

CLS02210 

CLS02220 

CLS02230 

CLS02240 

CLS0??S0 

CLS02260 

CLS02270 

CLS02260 

CLS0??90 

CLS0?300 

CLS0?310 

CLS02320 

CLS0?330 

CLS0?340 

CLS023S0 

CLS0P360 

CL502370 


uoo  cuuu 


FILFI  CLSFYl 


OUTPUT  THF.  0PI6TNAL  COVARIANCE  AND  MEAN  MATRIX!  AFTER  B»TRANSF0RM 
XVA1LA0LE>  FOR  ALL  SUBCLASSES.  ON  THE  CLASSIFICATION 
ESULTS  OUTPUT  FILE.  MAPTAP 


header  record  no.  3 FOR  MAPTAP 


C 

C 


MRITE(MAPTAP»  ( (COVMTX(l.J) .1 
• UAVEMTXd.J)  ,I 

BADFLC.  • 0 


. I.VARSZ2).J«1.N0SUB2). 
1*N0FCT2).J>1«N0SUR2) 


IF  (STATKY.FO.O)  60  TO  180 

CNT  ■ T*(S*3*2*NOFET2>«( !N0FET2*11)/12» 

CNT  ■ PA6SIZ/CNT 

INC  » CNT 

DO  170  ICLAS«l.N0CLS2 
NUMSUP  a SURNOdCLAST 


no  120, jjlal.NUMSUB 


GO  TO  100 


III  « 111  ♦ 1 
IF  (INC. LT. CNT) 

WRITF  (<S.HEAD) 

WRITF(6.65)NFILE 
INC  3 0 
100  CONTINUE 

WRTTF((S,110)  CLSHTXdCLAS)  .SUBOESdll) 

110  FOBMaT(//»  class  : '.A4/*  SUBCLASS:  *.AAl 
DO  lAO  L0C«1.N0FET2.12 
STOP  « L0C*n 

TF(  STOP  .6T.  NOFET?  ) STOP  * N0FET2 
1*0  WRITE  (A.. ISOM  AVEMTX(l.lIl)  .IsLOC.STOPI 
,1S0  FORMATMO  MF  an:  ..3X.12F9.2) 

IF(  RMFLG  .GT.  0)  60  TO  161 

WRiTE(6.160) 

160  forhat(//»  covariance  matrix:*) 

GO  TO  162 

161  WRTTF(6.1611) 

1611  format (//•  covariance  matrix  (B-TRANSFORMEO) 
162  CALL  WRTMTXICOVMTXd. Ill)  .N0FET2.  BCDTWO) 

INC  = INC»1 
J?0  CONTINUE 
170  CONTINUE 


OBTAIN  THE  ••MODIFIED' • CMOLESKY  DECOMPOSITION  OF  THE  COVARIANCE 
matrix  FOR  each  SUBCLASS.  THE  DETERMINANT.  AND  COMPUTE  THE 
••  CONSTANT  ••  term  of  The  PHOBAHILITY  DENSITY  function 
* -7  * LOG  0(1)  ♦ LOG  determinant  (I)  « WHERE  Qd)  IS  THE 

APRIORI  probability  value  for  SUBCLASS  I 


•) 


PDF  3 Dd)  • ( 0ETd)«**-l/2  <•  E*»-l/2  •►  (X-M)*  ••  K**>-I  • (X-M)  ) 
LOG  PDF  3 -1/2  • ( CON  ♦ (X-H)a  <•  K**-l  • (X-M)  ) 


IBO 


IBl 


!l|02420 

;lS02A30 

LS02440 

LS02AS0 

LS02A60 

LS02470 


St; 


>02460 
>02490 
>02500 

>02sT0 
>02S?0 
__io2530 
CLS02S40 
CLS02S50 
CLS02560 
CLS02S70 
CLS02S80 
CLS02S90 
CLS0260 


imt 

CLS02630 

CLS02640 

CLS02650 

clsoHgo 

CLS02670 

Stl8ll88 

CLS02700 

CLS02710 

|ipi!8 

CLSO 
CLSO 
CLSO 

CLSO 

CLS02790 
CLS02BO0 


740 

750 

760 

770 

760 


CLS02630 

CLS02640 

CLS02850 

CLS02860 

CLS02670 

CLSO28B0 

CLS02B90 

CLS02900 

CLS02910 

CLS02920 

CLS02930 


DO  195  NCi.Ssl,N0SUB2 

TRANSFER  ORIGINAL  COVARIANCE  MATRIX  TO  TEMPORARY  STORAGE  ( COV  ) 


DO  161 
COVd)  : 


l3l .VARSZ2 
COVMTXd.NCLS) 


OBTAIN  THE  ••MODIFIED"  CHOLESKY  FACTORIZATION  OF 
COVARIANCE  MATRIX 


CALL  MChLSK(  COVMTX(I.NCLS) . 


NOFET2. 
163 


THE 

OUM.  DET(NCLS)  ) 


IF(  nFT(NCLS)  ,GT.  0.0)  GO  TO 
WHITF(A.mon)  NCLS,  DETINCLS) 

IBOO  FOOMAM////  sx, ••<••••  CLSFY/CLSFYl/ 
IRIX, FOR  subclass  NO'. 14.'  “ ' 


the 

IS  either  SINGULAR  OR  NOT 


COVARI 

POSITI 


CLS02960 
CLS02970 
CLS02960 
CLS02990 
CLS03000 
CLS03010 
CLS03020 
CLS03030 
CLS03040 
CLS03050 
CIS03060 
CLS03070 
CLS03060 
CLS03090 
CLS03100 
CLS031I0 
CLS03120 
CLS03130 
CLS03140 
ANCE  MATCLS03150 
VE  OEFINCLS03160 


r*r» 


FILFI  CLSFYl 


?ITE»//  35 X.'OETCHM inant  ■*»F20.A///5X, 
3 EXECUTION  •••••*  ) 


TEfIMlNATINO  FROORAM  CLSO 


183 


S8”?!!® 

APR  ■ 

CON(NCLS) 


1«5 

XRR  ■.*?«IOR(NC^| 


APR  • OETINCLSI 


OBTAIN  TmE 
EUCUOEAN 


OELATIVE  ERROR  OF  FACTORED  MATRIX,!  RATIO  OF 
NORM  OF  OlFFERENCEt  K-LOU*  ♦ TO  EUCLIDEAN  NORM  OF 


RERROR(NCLS)  ■ RELERR!  COVMTX (1 tNCLS) ♦C0V*N0FET2f VARS22) 


IR5  CONTINUE 


ERROR  termination*  IF  ONE  OR  MORE  SUBCLASSES  HAVE  AN  1 

Singular,  or  non-positive  definite)  covariance  matrix 

IF(  BADFLG  .6T.  0)  CALL  EXIT 


INVALID 


‘LSO 
CLSO 
CLSO 
£l|o 

cCso2 

CLSo;.,^ 

CLS03380 

CLS03390 

ill??*' 





HEADER  RECORD  NO.  A FOR  HAPTAP 

WRITE (maptaP)  ( <covmtx ( I •Wi*l;i ♦ VARS??| ’KSIHIIl * 
» <CON(I) *I«l*NOSue2) « (OETll) ♦I«I.NOSU02) 

(STATKV.FO.O)  go  TO  230 


IF. 


CLS03A50 

CLS03460 

CLS034T0 

LS03480 

LS03490 

CLS03500 

CLS03510 


CNT  ■ 13  * . 

CNT  ■ PAGSI7/CNT 


<5*2*NOFET2)  • 


CLSOSS^g 


INC  « CNT 


iiSlO 


■ n 

L»1 .N0CLS2 
SURNOJU 
0 I>1*NSUBCL 

in  ♦ 1. 


WRITE  <6. HEAR) 


(INC. LT. CNT)  GO  TO  200 


WRITE(6.6S)NFILE 
IN^_.0 


200  WRtTE(4.220)CLSMTX(L)  .L.SUROESn  1 1)  .III  » 
CALL  WRTMtX(C0VMTX<l,III).N0FET2.BC0F0R) 


II.OET(IlI) .CON(III) 


.(NOFET2.ll)/12) 

CLS03S40 
CLS03|50 
CLS03S60 
CLS03570 
CLS03S80 
CLS03590 
CLS036P0 
CLS03610 
CLS03620 
CLS03630 
CLS03640 
CLS03650 
CLS03660 
CL|03670 

**  wD T Tr  f • 9 Ac; ) wrQQnQ  f t T f I CLS036A0 

20S  format ( IX ;.i*  RELATlvr ERROR  ( EUCLIDEAN  NORM  (K-LOL*) /EUCLIDEAN  CLS03690 
INORM  K ) »•  , F,3.8  //  ) cl:loi7?S 

INC  ■ INC*1  ^lIo3730 

§20  f8rmAtVihP//  TSO.'MULTISPFCTRAL  characteristics  F0R*/T57.A4.  £!-|2lZ52 

!•  ( CLASS', 13.'  )',/T56.A4,2X,'  ( SUBCLASS' , 1 3.  • )•// 

? 1HO.  •DETFR'^iNANT  a'*F2S.4  / IHO.  'PROP.  DENSITY  FUCLS03760 

2n{ti6n  - CONSTiNT  TERMi'lFlO. 4//  IHO, 'COVARIANCE  MATRIX  (Ch6lESKVCLS03770 
3 FACTORIZATION)  ;'  / ) CL|03780 

CLS03800 
CLS03810 
CLS03820 
CLS03830 


230  CONTINUE 


GO  TO  7ft 


FNR 


CLS03B40 


r»r>r>r>r»(->rv->or»or»oor»orvr»oor>or»r»<-»or»i 


riLFl  aSFYZ 


SUBROUT  I NE^CLSF Y? « COVMTX , A VEHT* , FLOHTX . CLSHTX ♦ SUBOES  # SUBNO * 
* n ATNwtBnATRXl 

IMPLICIT  INTEGER  (A-H«0-Z) 


CLSOOOIO 
CLSOOOEO 
CLS0003II 
CLSOOOAC 
CLSOOOSC 
' 10006C 
i0007( 


Call • • • 
^RGS • • • 


— — — — — — — iCLSOOOiO 

CALL  CLSFY2CCOVMTXtAVEMTX,FLOMTXfPUNMTX,CLSMTX*BMATPX>  *ClIoO®‘‘ 


COVMTX 


AVFMTX  I 


FLOMTX 


cation  of  the  COVARIANCE  MATRICES  ^HLSOoilo 
IN  ••SYMETTRIc*'  STdRAGg)  FOR  NOClSZ  TRAININGCLSOO  30 
ASSES  CLSOO  AO 


LOCATION  OF 
CLASSES 
LOCATION  OF  TMi 

vectors  (NOFET 


MATRIX  OF  training 
MEANS  PER  CL ASS I 


CLASS  MEAN 


natrix  of  training  field (s> 

INr OH“AT ION 


BMATRX  1 
SUBOES  : 
SUBNO  S 

katno  t 


PURPOSF.. 


e 


CLSMTX 

-transforma 


LOCATION  or  MATRIX  OF  TRAINING 
nation  MATRIXfIF  AVAILABLE 


CLASS  NAMES 


LOCATION  OF  SUBCLASS  NAMES 
LOCATION  OF  NO.  OF  SUBCLASSES  IN  EACH  CLASS 
CATEGORY  - CLASS  CORRESPONDENCE 


ARRAY 


BMATRX 


: LOCATION  OF  THE  • ‘fl • •-TRANSFORMATION  MATRIX, 

Tf  availaple,  for  transformation  of  input 
sample  vector  in  SUBR.  CONTEX 


CLASSIFIES 
POtNTSI  On 
PRESCRIREO 


LES.(  MULTI-CMANNEL  DATA 
- OF  THE  SET  OF  SCAN  LINES 
0 BY  THE  ••FIELO  OEFINITfON«i  CARO  INPUT 
IFIcaTION  PROCESSOR.  CLASSIFICATION  IS 
BY  THE  MgTHOO  OF^MaXIMUM  L^R^^^MOOj^ 


■<E  method  of  maxTmum  lj*^ 
Jl^ltY  OF  MJS-CLASSIFlf 


TO 


ElIoo210 

CLS00220 

CLSOO^SO 

_]6o|lo 

CLS00270 

CLS00300 

CLS00310 

cl|oo3?o 

ClIi)0330 

ICLS003A0 

fcLSooSso 

kinm 

CLS003B0 
LS00390 
LS0040Q 
LS00410 


PERFStMFO 

(MINIMUM  PROB6B 

CONTEX  . THE  OIMENSIONALItY'OF  THE  SAMPLE  CCSOOAZO 
IS  PRESCRIBED  BY  CONTROL  CARO  INPUT  TO  THE  PROCESSOR  CLS0Q430 
(BMCOMR)  OF  CHANNELS  (BMFEAT)  1n  THE  ••B»*  - MATRIX,  CLS00446 
(• 'CHANNELS* • ) OR  BY  THE  NO,  OF  LINEAR  COMBINATIONS  CLf 00450 
IF  available  . CLi00460 

CLS00470 
CLS004A0 


RETURNS.. 


TF  STANOARO  CLASSIFIER  IS  USED 

IILITY  density  FUNCTI 


NUM3FR  AND  PROBABILITY  DENS 

VALUE  for  each  point  of  F 


IS  OUTPUT  ON  THE 
TF  CATEGORY  CL*SSl 

number  of  the  subclas 


IS.U< 


c^ass^fi^ation  ouipy 

, SUBC^  ■■ 

- TION  V 

pworahility  density  function  valu 

CATF60RY  FOR  EACH  POINT  OF  EVERY  SCAN  LINE 
FIELD  IS  OUTPUT  ON  THE  CL ASS  IE ICAT lON  OUTPUT 


INE  Of  THE  riELO 

t^file  ,.maptap. 


...  - ^ — ^LASS  VITH  TH 

fTFNSlTY  EUUCTION  VITHIN  THE  ' 


the  subclass 

TION 

very  scan  l 
ATION  OUTPUT  file  1 
ED.  THF  SyflCLASS 
LARGEST  PROBAhIlITY 
SEN  category  ANO  THE 
' “ CHOSEN 

, - - . Of  The 

classification  OUTPUT  EILE. 


CH£ 


INCLUDE  COmhka.LIST 
INCLUOE  COMUKt.LlST 

COHHON/INFO»H/NOCLS2.NOSUfl?,NOFET2,VA«SZ2,TOTVTP.NOELn?, 

• *VAW2,C0VAR?,CLSID2.SUHN02»SUB0S2.FL0SV?,VERTX2, 

• FF.T  VC2(30)  ,SUHVC2(  7S)  ,SUHPTR(7S)  «CLSVC2(60>  , 

• KFPRTS(M)>  »NOGRP,GHPNAM(60) ,GRP0FX(6l> , 

• GRRCHK (61) .GROUPS (124) 

COMMON  /CLASS/  APRFLG.HMCf)MH,BMFtAT,HMFLG,MOCAT,THl Jl.lOATAl, 

• NF ILF ,STAThY,CATNAM(^0) , 

3 CLSSYM(60) ,CON(60) ,DET(60) .FLOESC.FLOINF (b) , 

4 RCLSNA (hO) .NOCTCL (60) .SUBCAT (60) 

• , NOCHAN. CHNVEC ( 30) 

rOMMON/(.LUBAL/HtAn(63)  .mAPTAP.OATaPF,  .SAVTAP.HMFILE.BHKEY. 


ICLS00490 

CLSOOSOO 

CLSOOSIO 

CLS00520 

CLSO0S30 

CLSOftf40 

CLS00S50 

CLSOOSGO 

CLS00570 

CLSOOSBO 

CLS00590 

CLSnObOO 

iCLSOOblo 

■ICLS006P0 

■ICLS00b30 

CLS00640 

CLS00650 

CLSOObbO 

CLS00670 

CLS006B0 

CLS00690 

CLS00700 

CLS00710 

CLS00720 

CLSO0730 

CLS00740 

CLS007S0 

CLS00760 

CLS00770 

CLS00780 

CLS00790 


JM^2 


Flue  I CL«Ft2 


^SCNO 


• HlSFILtM!SKcY.i^ORHlE«IPTF.CRPnev,M4kPUNTtNOFlLEt 


PE»t  CONtOCTt  VRaOOOJ  .COVMTX<VARSZ2«NOSUS2).AVEMTX<NOFET2t 

• N0SUB2) *BMATRX 


OIPENStON  FLnnTX«*,N0ru02) •CLSMTX(l) *VERTCS(22) 


‘LSO0B20 

■8I388P 

‘lsoobro 

CLSO0B90 

CLSOOROO 

CLfor 

>66930 


• •• 


NOTE 


:uSSf’ 


THE  lOXTA  ARRAY  IJ 

ARRAYS.  EQUlyALENC 
LOCATIONS  USED  BY 

SCAN  line  and  the 

VALUES.  RESPECTIVELY. 


FOR  INPUT  OF  the  scan  LINF 
_ . CONTEX.  AND  ALSO  TO  STORE  T 

NE.  BY  CONTEX,  THE  MIR*»  AND 

FD  TO  The  ioata  array,  are 

QNTEX  TO  OUTPUT  THE  CLASSIFIED 
ROBABIlITY  density  FUNCTION 


CLSO] 

INCLUDE  C0MBK2.LIST  CLSO 

CLSOl  ^ 

equivalence  (FLDINF(I),  LINSTR).  (FL0INF(2) .LINENQ) . CLS01I30 

(FL0iNF(3» .LININC) . (FLQINF«A>.  SAHSTR) . CLSOIIAO 

<FL0fNF(§).SAHEN0>.(FL0INF<6).SAMlNC».  CLSOllSO 

1 (FLOiNFtf) .FLOTYP)  CLSOiioO 

CLSOllTO 

CLSOliao 

CLSonso 

^l:l§!i?8 

CLS01220 

COHHON  /SCRACH/  IOATA (I2b00)  CLS01230 

CLS0l|*6 
CLSOIPSO 
CLSOI2A0 
CLS01270 
CLSU12S0 
CLS01290 
CLSonoo 
CLS01310 


DATA  LINMAK/IOOO/.  ENOBCO/'SENO'/.  DASH/*——*/ 
equivalence  (IR.COLt 

DATA  LFwN/.(  •/, blank/*  •/ 


READ  TME  field  OESCRIPTION  CARO. CONTAINING  LINE-SAMPLE 
OF  THE  FIELD  TO  R£  CLASSIFIED 

CALL  TAPmOR(OATAPE.OATFIL» 

10  CONTINUE 
PTSTHS  » 0 

icK  « lapeao<flocsc.vertcs.floinf.nc» 

IF  ( ICK  ,F0.  0 » GO  TO  lAO 

IF  (ICK  .EO.  -1  .OH.  ICK  .EQ.  -2»  60  TO  10 

30  CONTINUE 


CLS01320 

CLS01330 

CLS013A0 

CLS01350 

CLS01360 

CLS613T0 

CLS013B0 

CLS0I390 

clsoIaoo 

CLSOIAIO 

CLS01A20 
CLS01A30 
CLSOlAAO 
CLSO i A SO 

COOROlNATESCLSOUfrO 

CLS0I470 

CLS014A0 

CLS014N0 

CLS01500 

tLSOlSlO 

CLS01S20 

CLSO1530 

CLS01540 

CLsoiSSo 

CLS01560 

CLS01570 

CLSOISBO 


f V9 


OP.'r 

Or 


1'  r 


fs 

Y 


r>r>r>  nrtnrtnnn  r»o  o non  oooo  r>  r»  r»  r»nr»  r>  r>onr» 


filf:  CLSFY? 


WR1TE(%.HEA0» 

NCI  * 2*NC 
NV  = NC  - I 

WRITE  (^.ISiFLOESCtNV.FLDlNFCe)  tFLOINFO)  • (LPRN,  VEHTC^i  ( I>  ♦ 


3" 


VFRTCS(I*1)»I=1.NC1.2) 
FORMAT (////  TS6*iAREA  ““ 


3 


36X,iSAMPLE»»3X» 


- OF  CLASSIFICATION*/// 

•LINE'*  / 5Xt*FIELQ  NAME 

3Xt*INC.*»30X.iVEHTICES*  ..  

S(Al*I4**t*«U«*T*t2X)  / (52X*S(AltUt'***l4t*)*t2X)/n 


/ SX.tFIELB  NAME*»3Xi 'NO.  OF  VERTICES* t3X. • INC. 

/ 7X.A4.14X.I2»10X»I2.6X»I2.5X, 


Save  classified  field  information  on  maptap 


so  CONTINUE 

• initialize,  tape  heading  for  this  field 

CALL  FLO I NT ( FLO I NF , CHNVEC • NOCM AN ) 


LINES  * ( LINENO-LINSTR)/LININC  ♦ I 
PTS  = ( samfno-samstr>/saminc  ♦ 1 

IF  (PTS  .GT.  LIN'-AX)  WRITF(6.55) 

S5  format ( //  SX. ‘WIDTH  OF  RECTANGULAR  FIELD  SURROUNDING 
•ON  FIFLD  CONNOT  EXCEED  1000  POINTS.*) 

IF  (PTS  .GT,  LINMAX)  call  CMERR 

SCANLN  = PTS  * NOFET2 

IF  (SCANLN  .GT.  (IZSOO'IDATAl*-!))  GO  TO  170 
FIELD  RECORD  FOP  MAPTAP 

WRITE (»*aPTAP) (FLDINF(I) ,I=ltG) .PTS.LINES.FLOESC.NC* 

* (VEHTCS(I)  tlsltNC)  t (VEHTCSd^NC)  *I  = lfNC) 

classify  the  field 
CALL'iETMRGT6f7oT667 
WRITE  (4, HEAD) 

CALL  MAPmOG (NOCAT, CLSSYM,CATNAMtKATN0,CLSMTX.SUBN0*SU8DES) 
WRITF(<S.B00) 

BOO  FORMAT  (///) 

J = 0 

DO  flO  t=samsth,sameno,saminc 

J = J*1 

COL (1,J)  = I/lOO  . 

COL(2.J)  = M00(l,100)/10 
COL(3,J)=MO0(I.10) 

IF  (J.F').ntU  GO  TO  90 
no  CONTINIJF 
on  DO  100  1=1,3 

100  WRTTF  (4,110) (COL(I.K) ,K=1,J) 
no  FORMATC  '.nx, 11011) 

WRTTF(6,11S) 

IIS  FORMAT!  / ) 

ILINE=LINSTR-LININC 

no  140  jLiNFsi, lines 

CALL  LTNERDdDATAdDATAl)  .ENOTAP) 

IF  ( ENDTAP  ,E0.  -1)  GO  TO  ISO 

iline=iline*limnc 

•**  classify  the  scan  LINE  IN  IOATA 
call  standard  classifier 

IF  (NOCAT  ,LE.  0)  CALL  CCTEX  (NOFET2,NOSU02,PTS,  AVEMTX.COVMTX, 

* BMaTHX.TOATAdOATAl)  , VEHTCS  ,NC  , IR  , VR  , IL INE  , IOAT  A ( THIJI ) ) 

CALL  CATE(iOHY  CLASSIFIER 

IF  (NOCAT  .r,T.  0)  CALL  CAT6RY  ( N0FET2 , PTS , AVEMTX  ,COVMTX , 

* IP.VR.HMATPX.IDATAdOATAl)  , I L I NE  , VER  TCS  ,NC  , PTSTHS ) 


CLS0;S90 
CLS01630 
CLS01610 
CLS0I620 
CLS01630 
CLS01640 
CLS01650 
CLS01660 
CLS01670 
CLS016P0 
CLSOlbOO 

CLSOI700 

CLS01710 

CLS01720 

CLS01730 

CLS01740 

CLS01750 

CLS01760 

CLS01770 

CLS01780 

CLS01790 

CLS01800 

CLSOieiO 

CLS01820 

CLASSIFICATICLS01830 

CLS01840 

CLS018S0 

CLS01860 

CLS01870 

CLS01880 

CLS01890 

CLS01900 

CLS01910 

CLS01920 

CLS01930 

CLS01940 

CLS019S0 

CLS01960 

CLS01970 

CLS01980 
CLS01990 
CLSOPOOO 
CLS02010 
CLS02020 
CLS02030 
CLS02040 
CLS020S0 
CLS02060 
CLS02070 
CL5020HO 
CLS02090 
CLS02100 
CLS02110 
CLS02120 
CLS02130 
CLS02140 
CLS021S0 
CLS02160 
CLS02170 
CLS02180 
CLS02190 
CLS02200 
CL  S02210 
CLS02220 
CLS02230 
CLS02240 
CLS022S0 
CLS02260 
CLS02270 
CLS022H0 
CLS02290 
CLS02300 
CLS02310 
CLS02320 
CLS02330 
CLS02340 
CLS023S0 
CLS02360 
CLS02370 


lyiA 


nort  r>or»r»  n nnn  nnnnnn 


FILE*  CLSFY2 


1?0 

130 


OUT(JKL) 
our  (JKU 


no  120  JKL>1»J 

ISYHC)  = I«(JKL) 

IF  ( rSYMfl  ,Ef),  I 

IF  ( i«;ymu  ,ne.  I 
continue 

WRITE  (6»130» ILINE. (OUT(I) tIaltJ) 
FORMAT!*  • tl5tAX,110Al» 

SAVE  classified  INFORMATION  ON  MAPTAP 


3LAMK 

CLS'YMdSYMB) 


DATA  RECORD  FOR  MAPTAP 

WRITE  (MAPTAP)  ILINE*  (IRd)  .I  = 1,PTS)  .<VR(I),lal,PTS) 
lAO  CONTINUE 

IF  (PTSThS  .6T.  0)  write (6. US)  PTSTHS 
S *aS  - ' 


CLS02380 
CLS02390 
CLS02A00 
CLS02A10 
CLS02A20 
CLS02A30 
CLS02A40 
CLS02AS0 
CLS02A60 
CLS02A70 

— — CLS02AR0 

CLS024R0 
CLS02500 
CLS02S10 
CLS025P0 
CLS02530 

- ^ - ...  CLS02540 

US  format (////qx, «aS  the  COMPUTER  CANNOT  EXPONENTIATE  A NUMBER  SMALLECLS02550 
*R  Than  EXP(-A9) ,i,16»*  PTS  were  not  CLASSIFIED  IN  THIS  FIELD*)  CLS02560 
ISO  ILINE  » 0 CLS02570 

CLS025R0 

END  OF  FIELD  RECORD  FOR  MAPTAP  CLS02590 

CLS02600 

WRITE  (MAPTAP)  IL INE  » ( IR  ( I ) « U1  (PTS)  t ( VR(  I ) » UliFTS)  CLS02610 

CLS02620 

00  TO  10  CLS02630 

CLS02640 

GO  HOME  CLS026S0 

CLS02660 

CLS02670 
CLS026S0 
CLS02690 
CLS02700 
CLS02710 
CLS02720 
CLS02730 
CL502740 
CLS02750 
CLS02760 
CLS02770 
CLS02780 
CLS02790 

DATA  REQUESTED.  DO  ONE  OF  THE  FOLLOWING:*  CLS02800 
CLASSIFIER  -*/l IX. *REOUCe  PARAMETERS  SUCH  THCLS02810 
•AT •/! IX, • (NO,  OF  SU8CLASSFS-1)*(N0.  OF  SUBCL ASSES-2) /2  ♦ NO,  OF  SUCLS02B20 
•BCLASSFS  ♦ (PTS  PER  SCAN  LINE)*(NO.  OF  CHANNELS)  ♦ 12S00*  /7X,  CLS02830 

*•2)  FOR  category  CLASSIFIER  -*/llX,  »REOUCE  OATA  REQUESTED  SUCH  TCLS02840 
•hat  •/  IIX,  » (PTS  PER  SCAN  LINE)^(N0.  OF  CHANNELS)  ♦ 12S00,*)  CLS02H50 

CALL  CMERR  CLS02860 

EMO  CLS02870 


UO  PTS  s 0 

ENO  OF  RUN  RECORD  FOR  MAPTAP 

WRITE  (MAPTAP)  (FLCINF(I)  ,U1  ,6)  .PTS.LTNES.FLDESC.NC. 
• (VERTCS(I)  .I  = 1.NC)  . (VERTCS(  UNO  .I  = 1,NC) 

CALL  SFTMRf, (66.4,62) 

RETURN 

170  WRITF(6,17S) 

17S  FORMAT (//SX,*TOO  MUCH 
*/7X.  • 1)  FOR  STANOARO 


'5/ 


FILEt  CONTEX  , 


CSENO 
C 


SUBROUTINE  CONTEX (NCHAN.NC»NPTS»AVE»C0V#8MATRt lOATA.VERTCStVTt 
* IR.VR.ILINEfTH) 


INCLUDE  C0MRK2»LIST 

COMMON  /CLASS/  APRFLG«BMCOMB»BMEEATtaMFLG»NOCATfTHlJl*IOATAl» 

* . NFILE.STATKY.CATNAM(60) « 

3 CLSSYM(60) »CON(60) »OET(60) .FLOESCiFLDINF (6>  t 

4 KC|.SNA(60)  «NOCTCL(60)  «SUBCAT(60> 

* »NOCHAN*CHNVEC(30) 


INTEGER  BMFLG*BMC0MH,8MFEAT 
* »SAMSTR«SAMIUC.SAMEN0 
INTEGER  VERTCStVTfFL 


CONOOOlO 

CON00020 

CON00030 

CON00040 

•CON00050 

CON00060 

conoooto 

CON00080 
CON00090 
CONOOlOO 
CQNOOliO 
CON00120 
CONGO  130 
CONGO  140 
CONGO  150 
CONGO  160 
CON00170 
CON00180 
CONGO  190 


C 

C . 
C 
C 
C 

C 

C 


C 

C 

C 

c 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

CI- 

CI- 

Cl 

Cl 

Cl 

Ei 

Cl 

8i 

Cl 

Cl 

?1 


•CON00200 
CON00210 
CON00220 
•CON00230 
CON00240 

CON00250 

LOGICRL  -BMFLAG  * KOI  CON00260 

CON00270 

CON00280 

DIMENSION  lOATA(l)  *AVE{1)  fCOVm  *OATA(30)  CON00290 

l»JORDER(60) ♦BMATR(0MCOMB*8MFEAT) tJTEST(60) »1R(1) »VR(1) • CON00300 

* NCNT(60) .OM(30) »FL(22) *VERTCS(1)  CON003l0 

CON00320 

CON00330 

DIMENSION  TH(1)  CON00340 

— — CONGO  350 

CON00360 

tISiNG  THE  • ‘MODIFIED* • CHOLESKY  DECOMPOSITION  OF  THE  COVAR.  MATRIX  t CON00370 
THE  ROUTINE  COMPUTES  THE  PROBABILITY  DENSITY  FUNCTION  AND  OBTAINS  THECON00380 
MAXIMUM  PROBABILITY  ( “MAXIMUM  LIKELIHOOD'*  ) .OVER  ALL  CLASSES  OF  CON00390 

THF  SET  OF  TRAINING  CLASSES.  FOR  ASSIGNING  A CLASS  TO  EACH  RESOLUT IONCON00400 


ELEMENT  ( “PIXEL**  ) IN  THE  INPUT  SAMPLE  VECTOR  (INPUT  SCAN  LINE  ) 

THE  PRE-COMPUTEO  CLASS-PAIR  THRESHOLDS.  IN  TH  . ARE  USED  TO  MINIMIZE 
THE  NUMBER  OF  CLASS  PROBABILITY  DENSITY  FUNCTIONS  (PDF)  COMPUTED 
TO  obtain  the  MAXIMUM  PDF  FOR  A GIVEN  SAMPLE  BEING  CLASSIFIED  . 

THE  IRVR  ARRAY  IS  USED  TO  RETURN  THE  CLASS  NUMBER  AND  PDF  VALUE 
FOR  EACH  sample* ON  THE  INPUT  SCAN  LINE 


CALL...  CALL  CONTEX (NCHAN.NC.NPTS. AVE.COV.BMATR. IDATA.VERTCS. 

VT.IR.VR.ILINE) 

ARGS..  NCHAN  ! THE  NUMBER  OF  CHANNELS  TO  BE  USED  IN 
CLASSIFICATION  OF  EACH  DATA  SAMPLE. 

NC  ; THE  NUMBER  OF  SUBCLASSES  ( TRAINING  CLASSES. 

CONTINUE 

FOR  WHICH  COVARIANCF  MATRICES.  MEAN  VECTORS. 

AND  CLA$S-PAIW  thresholds  ARE  AVAILABLE  - 
REPRESENTS  THE  MAXIMUM  NUMBER  OF  POSSIBILITIES 
FOR  CLASSIFICATION  OF  EACH  DATA  SAMPLE.) 

NPTS  : THE  NUMBER  OF  INPUT  DATA  POINTS  (PER  CHANNEL) 
ON  the  RECTANGULAR  FIELD 

VERTCS  : VERTICES  OF  FIELD  TO  BE  CLASSIFIED 


CON00410 
CON00420 
CON00430 
CON00440 
CON004S0 
CON00460 
CON00470 
CON00480 
CONO0490 
CON00500 
CON00510 
CON00520 
•ICONG0530 
•ICON00540 
ICON00550 
CONG0560 
CON00570 
CON00580 
CON00590 
CONGG600 
CONOOtoiO 
CON00620 
CON00630 
CONG0640 
CON00650 
CON00660 
CONOn^TO 
CON00G80 
CON00690 
CON00700 
CONGO  MO 
CON00720 
CON00730 


i 


file*  CONTEX 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

Cl 

C‘ 

c 

c 

Cl 


VT  1 NO.  OF  VERTICES  OF  FIELD  TO  BE  CLAbSiriEO 

IR  t WILL  CONTAIN  THE  CLASSIFIED  DATA 

VP  J WILL  CONTAIN  THE  CORRESPONDING  PDF  OF  IR  ARRAY 


INLINE  t 


SCAN  LINE  number  FROM  DATA  TAPE 

TO  BE  CLASSIFIED  ON  EACH  INPUT  SCAN  LINE. 


CONTINUE 


OTHER.. 


Cl 

l\ 

Cl 

Cl- 

Cl- 

c 

c 


AVE 

cnv 

CON 

8MATR 

lOATA 

bmflg 

BMCOMB 


THE  VECTOR  0F»*NCHAN»*  mEANS(  OR  ••BMCOMB** 
MEANS  IF  THE  ••8-TRANSFORMATION**  MATRIX 
HAS  BEEN  APPLIED). 

COVARIANCE  MATRIX  ( AFTER  CHOLESKY 
FACTORIZATION)  - ACTUAL  DIMENSION  OF  COV. 

IS  OEPENOENT  ON  WHETHER  IT  HAS  BEEN 
• •B-TRANSFORMEO* • . 


THE 

FOR 


• • CONSTANT  * • 
EACH  CLASS 


OF  THE  PROS.  DENSITY 


THE  ••B"  -TRANSFORMATION  MATRIX 
THE  SCAN  LINE  TO  BE  CLASSIFIED 


A FLAG  TO  INDICATE  THE 
• • B- TRANSF  ORMAT I ON • • 


PRESENCE 
MATRIX  . 


,'HE  NUMBER 
CHANNELS. 


OF  LINEAR  COMBINATIONS  OF 
IN  THE  • 'B* '-MATRIX. 


OR  ABSENCE  OF 
BMFEAT 


EQUIVALENCE 


S 

* 


(FLOINF(I) .LINSTR)  . 
<FLOInF(3) .LININC)  . 
(FLDINFIS) .SAMEnD)  • 


<FL0INF<2) .LINENO) « 
(FLOINF(A) fSAMSTR)  * 
(FL0INF(6).SAMINC) 


1 

1 

C 

C 

C 

c 


BMFLAG  = bmflg  .GT.  0 
IF(  HmFLAG  > GO  TO  1000 
NV  = NCHAN 
GO  TO  1001 

000  NV  = BMCOMB 

001  KOI  = NV  .EO.  1 

NPC  = ( NV  * (NV»1) )/2 

NMl  a NC  - 1 
DO  1 1=1. NC 

1 JOPOER(I)  = I 


IPTI 


1 


1 


2 JJ  = IPTI 

DO  100  1=1. NC 

00  NCNT(I)  = 0 


DO  110  1=1.NPTS 
IR(I)  = 0 
no  VR(I»  = 0.0 

call  FOLINT(VERTCS.VT.FL.ILINE.IPTS.NI) 

DO  250  LL=1.NI.2 

IB  = (FL(U.)  - SAmSTR)  / SAMINC  ♦ 1 
IE  = (Fl  (LL*n  - SAMSTR)  / SAMInC  ♦ 1 
IF  (MO, OfSAMSTP. SAMINC)  .NE.  MOO ( r L ( LL ) * SAM  INC ) ) 
IF  (IP  .GT.  IF)  GO  TO  250 
115  DO  200  II=IB.IE 


IB 


IB  » 1 


C 

C 

C 


DO  3 1 = 1 .rjc 

JTEST(I)  - 1 

FLOAT  THE  DATA  SAMPLE.  AND  APPLY  THt  "8* ‘-MATRIX. IF  AVAILABLE 


CONGO 7A0 
CON00750 
CON007S0 
CON00770 
CONO07B0 
CON00790 
CONOQ800 
CONOOBIO 
CON00b20 
CON00830 
CON008<»0 
CON00850 
CDN00860 
CON00S70 
HATRIXCON008BO 
CON00890 
CON00900 
CON009I0 
CON00920 
FUNCTION  CON00930 
CON009A0 
CON009S0 
CON00960 
CON00970 
CON009B0 
CON00990 
CONOIOOO 
CONOIOIO 
CON01020 
CON01030 
CON01040 
CON01050 
CON01060 
CON01070 
CONOIOBO 
•ICON01090 
'ICCNOllOO 
CONOlllO 
CON01120 
CON01130 
CON01140 
CONOliSO 
CON01160 
CON01170 
CON01180 
CON01190 
CON01200 
CON01210 
CON01220 
CON01230 
CON01240 
CON01250 
CON 01260 
CON0I270 
CON01280 
CON01290 
CON01300 
CON0131O 
CON01320 
CON01330 
CON01340 
CON01350 
CON01360 
CON01370 
CON01380 
CON01390 
CON01400 
CON04410 
CON01420 
CON01430 
CON01440 
CON01450 
CON01460 
CON0147r 
CON01480 
CON01490 
CO  jn  ISOO 
CON01510 


/53 


oonooooonooo  o nnoo  o n oooo  oo  on  o non 


FILE:  CONTEX 


IF  ( BMFLAG 


GO  TO  5 


00  A lalfNCHAN 
inUM  » NPTS  * U - 
DATA  ( I)  3 lOATAllOl 
GO  TO  15 


♦ II 


00  7 I«1*8MC0HB- 

SUM  * 0.0 
DO  6 KalfkiCHAN 
INOUM  a NPTS  ♦ (K  « 1) 
FOATA  = lUATAdNOUHl 
SUM  = SUM  ♦ aMATR(ItK) 

DATACn  = SUM 


* I - 

• FDATA 


6 
7 

CALC.  THE  LIKLIHOOO  VALUES  (PROBABILITIES.  IF  YOU  WILL) 


15  TFMAX  = -1.0E35 
JI  3 0 

COMPUTE  THE  PDF  FOR  CLASS  JJ 
20  JJMl  3 JJ  - 1 
LC  ~ NPC  • JJMl 

LOCATION  (-1)  OF  COV.  MATRIX.  CLASS  JJ 
IMN  * JJMl  * NV 

L0CATI0»4  (-1)  OF  mean  VECTOR.  CLASS  JJ 

KM  = IMN  ♦ 1 
S 3 DATA(l)  - AVE(KM) 

OMd)  = S 
LC  3 LC  ♦ 1 

TF  3 CON(JJ)  ♦ ( S * S )/C0V(LC) 

IF(KD1>  GO  TO  IA6 

LOOP  FOR  COMPUTING  THE  KD-TH  ELEMENT  OF  Y 


00  145  KD32,NV 

KM  * IMN  ♦ KD 

S 3 OATA(KD)  - AVE(KM) 

J1  3 KD  - 1 
DO  140  LO  3 l,Jl 
LC  3 LC  * 1 

140  S 3 S - COV(LC»  * DM(LO) 


(=L*«-l  * (X-M) 
IS  STORED  IN  S 


) . WHICH 


DM(KD)  s S 
LC  3 LC  ♦ 1 

COMPUTE  THE  KO-TH  TERM 


145 

146 


TF  3 TF  ^ 
TF  3 -.5 


( S * S 
* TF 


IN 

>/COV(LC) 


1/2  * 
3 1/2  * 


Y • D**-l  • Y 
(X-M)  * K**-l 


* (X-M) 


149 

150 


TEST  THIS  SAMPLE  PDF  FOR  CLASS  JJ  - IF  GREATER  THAN  THE  PDF  FOR 
CURRENT  CLASS  IC»  SET  1C  = JJ.  TEST  THE  CLASS-PAIR  THRESHOLDS  FOR 
OTHER  POSSIBLE  CLASSES  FOR  THIS  SAMPLE  - IF  THE  POF  FOR  CURRENT 
CLASS  IS  EXCEEDED  BY  ANY  CLASS-PAIR  THRESHOLD. EVALUATE  THE  PDF 
FOR  THE  OTHER  CLASS  OF  THE  CLASS-PAIR.  AND  REPEAT  THE  TEST  FOR 
MAX.  PDF.  IF  ALL  PDF'S  FOR  WHICH  CLASS-PAIR  THRESHOLDS  HAVE 
DICTATED  TO  PE  TESTED  HAVE  BEEN  EVALUATEO.  AND  THE  CURRENT  PDF 
FOR  CLASS  IC  IS  THE  MAX.  PDF  OF  ALL  PDF'S  EVALUATED. 

CLASSIFY  THE  SAMPLE  AS  CLASS  IC 

IF(  TF  .LE.  TFMAX)  go  TO  149 
TFMAX  = TF 
IC^»,JJ 
JTEST(JJ)  3 0 

JI  3 ji  ♦ 1 

IF(  JI  .GT.  NC  ) GO  TO  152 
J 3 JOROER(JI) 


CON01520 

CON01530 

C0N01540 

CON01550 

CON01560 

CON01570 

CONO1580 

CON01590 

CONOlGpO 

C0N01610 

CON01620 

CON01630 

CON01640 

CON01650 

CON01660 

CON01670 

CON0l680 

CON01690 
CON01700 
CONO1710 
CON01720 
CON01730 
C0N01740 
CON017S0 
CON01760 
CON01770 
CON01780 
CON01790 
CON01800 
CON01810 
CON01820 
CON01830 
CONO1840 
CON01850 
CON01860 
CON01870 
CON018BO 
CON01890 
CON01900 
CON01910 
CON01920 
CON01930 
CON01940 
CON01950 
CON01960 
CON01970 
CON01980 
CON01990 
CON02000 
CON02010 
CON02020 
CON02030 
CON02040 
CON02050 
CON02060 
CON02070 
CON02080 
CON02090 
CON02100 
C0NC21 10 
CON02120 
CON02130 
CON02140 
CON02150 
CON02160 
CON02170 
CON02180 
CON02190 
Cn  4o22&0 
CON022iO 
CON02220 
CON02230 
CONn2240 
CO'.022SO 
CON02260 
CON02270 
COK02280 
CON02290 


1^18 


or)  ooooooo 


FILE*  CONTE X 


IF(  JTEST(J) 
IF  ( 1C  .GT. 


ISO! 

1S02 

151 

152 


200 

2S0 


201 


.CO.  0)  00  TO  150 

J » GO  TO  1501.^ 

NTH  ■ ( (J-1)  * (J-2)  »/2  ♦ 1C 
GO  TO  1502 

NTH  a ( (lC-1)  * (lC-2) 

■ TH(NTH)  ) GO  TO 


IF(  TFHAX  .LT.  TH(NTH)  ) GO  TO  151 
JTEST(J)  a 0 
60  TO  150 

^0  TO'^20 
JJ  * 1C 

STORE  THE  CLASS  NO.  FOR  THE  SAMPLE*  IN  IR  « AND  THE  VALUE  OF  THE 
PDF  FOR  THE  SAMPLE*  IN  VR  . 

IR(II). a IC 
VR(II)  = TFMAX 

NCNTdC)  a NCNT(IC)  ♦ 1 

continAe 

IF  (LL  .EQ.  1)  IPTl  a IR(IB) 

CONTINUE 

SET  PROBABLE  CLASS  FOR  FIRST  SAMPLE*NEXT  SCAN  LINE 

ORDER  THE  CLASSES. ACCORUING  TO  FREQUENCY  OF  OCCURENCE  ON  CURRENT 
SCAN  LINE 

DO  201  1=1, NC 

JOROER(I)  = I 
DO  210  I=1*NM1 

IPLl  =1*1 
00  205  K=IPL1.NC 

IF  ( NCNT(I)  ,GT.  NCNT(K) 

ITEMP  a NCNT(I) 

NCNT(I)  a NCNT(K) 

NCNT(K)  a ITEMP 
ITEMP  = JOROER(I) 

JORDER(i)  a JOROER(K) 

JORDFR(K)  a ITEMP 
CONTINUE 


) GO  TO  205 


205  , 

210  CONTINUE 


RETURN 

END 


CON02300 
CON0|310 
CON02320 
CON02330 
CON023AO 


CON02356 
CON02360 
CON02370 
CON02380 
CON02390 
CON02A0O 
CON02410 
CON02420 
CON02430 
CON02440 
CON02450 
CON02460 
CON02470 
CON02480 
CON0249O 
CON02500 
CON02510 
CON02520 
CON02530 
CON02540 
CON02550 
CONC2560 
CON02570 
CON02580 
CON02590 
CON02600 
CON02610 
CON02620 
CON02630 
CON02640 
CON026S0 
CON02660 
CON02670 
CON02680 
CON02690 
CON02700 
CON02710 
CON02720 
CON02730 
CON02740 
CON02750 
CON02760 
CON02770 
CON02780 


onrior>^ 


FILFI  FALSY 


SU««0UTINE  FALSY(XL»XU»C*FXL.FXU*KC,i(N.KT*T.K*KPl,Sl.S2»Ul.U?fflB) 
niMRNSION  SI (K,K»  tS2<KtK) ,U1 (K) tU2«K) «8B(KtKPl) 

PE=.1E-05*C 

IF  (HF.l.T.  .000001)  BE  = . 000001 
IF(KC.FO.O)  GO  TO  7 

FXL  5 0(XL»S1.S2»U1»II2.B8.KT.T,K.KP1) 

FXM  = C(XO«Sl.S2tUltU2«BBtKT*T«K«KPl) 

7 R=(C-FXL)/(FXU-FXL) 

X=XL^R*(Xil-XL) 

FX  = G(X.SI.S2.U1.U2.B3.KT.T,K.KP1) 

FM=ABS(FX-C) 

1 = 0 

GO  TO  P 

R FXN  = G(XlM»Sl.S2fUl»U2.8B.KT*T»K.KPl) 

I = I ♦ 1 

F=AriS(FXN-C> 

TF<E.GT.F  .<)  GO  TO  25 
IF(E.LT.RE)  RETURN 
EM=E 

IF(XN.LT.X)  GO  TO  12 
XH=,5*tXU*XN) 

FXH  = R(XH,Sl«S2.in«U2.R8.KT*T»K»KPl) 

IF( ABS(FXH-C) .LT.RE)  GO  TO  30 
IF(FXH.GT.C)  GO  TO  U 
XL=XN 
FXI.=FXN 
X = XH 
FXsFXH 
GO  TO  IS 
14  XL=X 
FXL=FX 
X = XN 
FX='=’Xrg 
Xll  = XH 
FXII=FXW 
GO  TO  IS 
1?  XH=,S*  (XL*XfJ) 

FXH  = G(XH,S1.S2.U1.U2»6B»KT.T.K»KP1) 

IF(APS(FXH-C) .LT.RE)  GO  TO  30 
IF(FXHcGT.C)  GO  TO  13 
XL  = XH 
FXl =FXH 
XU=X 
FXOsFX 
X = XAJ 
FXsFXN 
GO  TO  IS 
13  XI.I  = XN 
FXII=FXN 
X = XH 
FX=FXH 

IS  TF(  I .EO.  ?S>  RETURN 
GO  TO  n 
?S  XN=X 
RETURN 

TO  XN=XH 

RETURN 

FOLLOwT  jG  coot-  FITS  A QUAORATIC  TO  THE  THREE  POINTS 
XL.  X . XU  WHICH  IS  AN  APPROXIMATION  OF  THE  FttNCTION  G<  H(X)  ) 
WITHIN  THE  OEFINEO  INTERVAL.  A ROOT  . XN  . OF  THE  APPROXIMATING 
OllAnRATIC  IS  returned  to  HE  USED  AS  A TRIAL  SOLUTION  OF 
G(  H(X)  ) = C?  - Cl 

P >'l  = X - XL 

W?  = X*X  - XL*XL 
w;^=FX-FXL 

W4=XU-Xi 

WS=XU*XU-XL«XL 

WSsFxU-FXL 

w7=C-FXL 

A=H1*W4-„^*W4 

IF(ARS(A)  .LT.n.E-7)G0  TO  44 
G=W3*WG  — v.('*wA 

F=-XL*XL*4-XL*»*w7* (W2*W4-W1*W5) 
n=R*P-4.0*A*E 
IF(0.Lt.«.)r,i)  TO  44 
OrSORT (0) 


FALOOOlO 
FAL00020 
FAL00030 
EAL00040 
FAL00050 
FAL00060 
FALOOOTO 
FAL00080 
FAL00090 
FALOOlOO 
FALOOllO 
FAL00120 
FAL00130 
FAL00140 
FALOOISO 
FALOOIGO 
FAL00170 
FALOOIBO 
FAL00190 
FAL00200 
FAL00210 
FAL00220 
FAL00230 
FAL00240 
FAL00250 
FAL00260 
FAL00270 
FAL00280 
FAL00290 
FAL00300 
FAL00310 
FAL00320 
FAL00330 
FAL00340 
FAL00350 
FAL003GO 
FAL00370 
FAL00380 
FAL00390 
FAL00400 
FAL00410 
FAL00420 
FAL00430 
FAL00440 
FAL00450 
FAL00460 
FAL00470 
FAL00480 
FAL00490 
FAL00500 
FAL00510 
FAL00520 
FAL00530 
FAL00S40 
FALOOSSO 
FAL00560 
FAL00570 
FAL00S80 
FAL00590 
FAL00600 
FAL00610 
FAL00620 
FAL00630 
FAL00640 
FAL006S0 
FAL00660 
FAL00670 
FAL00680 
F AL00690 
FAL00700 
FAL00710 
FAL00720 
F AL00730 
FAL00740 
FAL0O7S0 
FAL00760 
FAL00770 
FAL0O7B0 
FALO0790 


>r-20 

/^C 


FILF 


FALSY 


44 


XNa<-8»0)/«?.0*4) 

IF(XN.GT.XU)  XN=(-B-0)/(2.0*A) 
GO  TO  «» 

XNaX 
60  TO 
FNO 


FAL00800 

FALOOeiO 

FALO0820 

FAL00830 

FAL00840 

FAL00850 


riLCi  6 

FUNCTION  6(4»Sl»S2.UlfU2«B0tKT.T#K*KPl) 


5 

6 


14 

17 


?S 

27 

3? 

35 


niMENSION  U1(K)»  U2(K)t  Sl(K«K)t  S2(K«K)«  BB(KtKPl) 
DIMENSION  MJ(2)«JC(60) 

WJ(l)  = 4.0 

K7=0 

IF(  A .LE.  l.OE-8)  60  TO  25 

Pa<1.0-A)/A 

00  5 1=1. K 

PB(I.KPl)  = U2(I)  - UKI) 

DO  5 J*1.K 

RB(I.J)  = SKI.J)  ♦ P*S2(1.J) 

CALL  6JR(  BRf  KPl.  K.  K«  KPlt  &8t  JC.  WJ  ) 

WS2W=0. 

WU=0. 

no  17  1=1. K 

WU  a WU  ♦ HR(I.KPl)  • ( U2(I>  - UKI)  ) 

DO  14  Jsl.K 

WS2W  a WS2W  ♦ BB(I.KPl)  • BB(J.KPl)  • S2(I.J) 
CONTINUE 

IF(KZ.FO.l)  60  TO  32 
G=uij-P*mS2W/A 
IF(KT.EU.l)  GO  TO  35 
RETURN 
DO  27  1=1. K 

PB(I.KPl)  a U2(I>  - UKI) 
no  27  J=1.K 
RB(I.J)  = S?(I.J) 

KZ=1 
60  TO  A 

6=-wu 

RETURN 

TaP#P*wS2w 

RETURN 

END 


00010 

00020 

00030 

00040 

00050 

00060 

00070 

00080 

00090 

00100 

00110 

00120 

00130 

00140 

00150 

00160 

00170 

00180 

00190 

00200 

00210 

00220 

00230 

00240 

00250 

00260 

881^8 

00290 

00300 

00310 

00320 

00330 

00340 

00350 

00360 

00370 

00380 

00390 

00400 

00410 

00420 

00430 

00440 

00450 


U^52 

0 


IJN(A*NC«NR»N»HCf««JC«V) 

NR.NC)»JCa)«V(2) 

UK) 


|W/4, 

V( 


ifi  . 


?KI 


I 

I 


) tKI 
GO  TO 


0. 


60 


I 

;<A(J«I)))  60  TO  30 


lO  TO  60 


i).Kl 


I) 

T) ) .GT.O.)  GO  TO  70 
V(l)sO. 


')  tKO 

.0.)  Sa-S 

* ALOG(AeS(A(I»I) ) ) 


'I.;  - 


)/X 
( IPU 

60  TO  150 


GO  TO  91 


L 

)-X*A(l,J) 

(IFL) 

GO  TO  150 


0)  «KI 
N 

.J)  GO  TO  130 

• N 

U)  GO  TO  110 


U 

) 


V(2)mS 


6. 

6. 

6. 

6< 

6, 

G. 

6i 

6< 

6< 

G, 

6. 

t 

6, 

6, 

6, 

G, 

6, 

G> 

G. 

G. 

G. 

G» 

Gv 

6« 

Gv 

6v 

Gv 

Gv 

6v 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

6v 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 


Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 

Gv 


V(2)=S 


RETURN  I 
END 


GJR00800 

GJR00810 


rtr>  ~t  o r»  rwto  r>.->  oo  orM^oooooorjorjOi 


FILE  I MAPMOO 


SUBCLASSES 


SUBROUTINE  maPhoG (NOCAT »CLSSYM,CATN*M,KATNO.CLSMTX.SUBNO*SUBOES»  MAPOOOlO 

MAPOOOZ' 

maPOOOB 

THIS  routine  prints  ThE  HEADER  INFORHATION  FOR  THE  CLASSIFICATION  HAP0004 
map  in  CLASSIFY  AND  DISPLAY  MAROOOSO 

MAP00060 
MAPOOOTO 
MAPOOOBO 
HAPOOONO 
MAPOOIOO 
MAPOOIIO 
HAP00120 
MAROOnO 
MAPOOIAO 
MAP00150 
MAPOOUO 
HAP00170 
MAPOOIBO 
HAP00)90 
MAPOO? 
HAP00< 


NOCAT  — NO.  OF  CATEGORIES 
CLSSVM  — SYMBOLS  FOR  CAtCGORIES  OR 
CATNAM  — category  NAMES 


CL^SVM 
CATNAM 
kaTA’O 
clsmtx 
SU‘^^0 


SUHOES  — 
CLSVC2  — 


category  each  class  was  assigned  to 

CLASS  NAMES 

NO.  OF  SUHCLASSES  IN  EACH  CLASS 
SUBCLASS  NAMES 

CLASS  EACH  SUBCLASS  WAS  ASSIGNED  TO  (IN  COMMON 
BLOCK  INFORM) 


IMPLICIT  integer  (A-Z) 


INCLUOF  COMiKl.LIST 

^CL52. 

avaR?.cova«? 


common/ I nfo»m/n6( 


SEND 


FETVC?(30) 

KEPPTS(60) 

GRpCHK ( 6 1 ) f GROUPS (124) 


LOGICAL  ISWTM 
OImENSI  ' 


ON  CLSSYM(l) .CATNAM(l) tKATNO ( 1 ) tCLSMTX ( ) ) *SUBNO( 1 ) • 

• SUHOES (1) 

PRINTS  CATEGORY  CLASSIFIER  INFORMATION 

IF  (NOCAT  .LK.  0)  GO  TO  82 
WRITE (K.200» 

200  EORMfiT(//  Ta/.imaP  OE  category  classifier  CLASSIFICATION  RESULTS 

• ///  T32. •CATEGORY', T62,*CLASS'tT<>3.«SUHCLASS*/  T31. 

• »NO. • .TG7. tNAHE* ♦ TftO. »NO. • .T66» ’NAME'* 

• TPfl.*NO.*,TS*.  •NAME'tTlOl. 'SYMBOL*) 

no  (Sfl  1 = 1. NOCAT 

WRTTE(S,210) l.CATNAM(I) 

210  FOOM4T(/T31.I2,T3T,A4) 

TSwTH  s .TRI.'E. 
no  N3  JsI.mOCLSZ 
IF  (KATNO(J)  .FQ.  I)  60  TO  64 
GO  TO  6G 

64  IE  ( ISWTH)  GO  TO  6S 
wPTTE (6.220) J. CLSMTX (J) 

220  EORM4T(/T'>O.I?,T66.A4) 

TSWTH  s .TRUE. 

RO  TO  66 

65  writF(6,230) J.CLSMTX(J) 

230  P0R«AT(lH*.T6(i,I2.T66.AA) 

66  no  67  KsJ.'jOSMR? 

IF  ( CLSVC2(K)  .EO.  J ) 60  TO  70 
GO  TO  67 

70  NSUBCL  a SURNO(J) 

KK  s 0 

no  7S  L=1.NSU«CL 
KK  « K ♦ L - 1 
IE  tISWTH)  GO  TO  7? 

WRITE (6. 2sn)KK. SUHOES (KK) .CLSSYM IKK) 

2S0  format (TH8.I2.TR4, AA.T 103. Al) 

GO  TO  75 

7?  WRITE  (6. 24(1)  kk.SUmOES(KK  ) .CLSSYM(KK) 

240  EOO'-'AT  (1H*.TAH,I2.T94,A4.T103»A1) 

ISWTM  a .FALSE. 

7S  CONTINUE 
GO  TO  63 

67  CONTINUE 
63  CONTINUE 
6B  CONTINUE 

return 

PRINTS  STANOARO  CLASSIFIER  INFORMATION 


MAP00230 
MAP00240 
HAP002SO 
HAP00260 
MAP00270 
MAP00280 
MAP0O290 
MAP00300 
MAP00310 
MAP00320 
•MAP00330 
MAP00340 
MAP00350 
MAP00360 
MAP00370 
MAP00380 
“AP00390 
MAP0040Q 
MAP00410 
MAP00420 
MAP00430 
MAP00440 
MAPOOASO 
MAP00460 
MAR00470 
MAP004A0 
MAP00490 
MAPOOSOO 
MAP0051 0 
HAP00520 
MAP00530 
MAP00540 
MAPOObSO 
MAP00560 
MaPOOSTO 
MAPOOSRO 
MAP00590 
MAP00600 
MAP006I0 
MAP00620 
HAR00630 
MAP00640 
MAPOObSO 
MAP00660 
HAP00670 
MAP00680 
MAP00690 
MAP00700 

MAPoo  no 

MAP00720 

MAP00730 

MAP00740 

MAP00750 


FILFJ  MaPMOO 


^2  CONTINUE 


260 


WPTTE<6»260I 
F0»N*T(  // 

•5*  ///T«s 
•T7«»  'NAME 


60) 

/ T*?.  *MAP  OF  STaNOAPO  CLASSIFIEP  CLASSIFICATION 
.• CL  ASS *tT 77. 'SUBCLASS'/  Ta2. 'NO. ' .T50. 'NAME'.T72.' 
E'.TBS.'SYHBOL') 


SS 


Cj,SNUM 


WTH  ■ .IfiUF. 
no  B9  1*1.N0SUB? 

(CLSNUH.co.  CLSvCc(D) 

CL SNUB  ♦ I 


60  TO  65 


270 

H7 

2«n 

B9 


CLSNUM 
00  TO  A7 
IF  (tSWTM)  60  TO  A7 
WBTTF (6.270) l.SUBOES(I) .CLSSVM(I) 
F09“AT (T72.12.T7d.AA,T87.Al) 

GO  TO  69 
WRTTF(6, 


,260)  Cl 
FOBMaT (/TA2«I< 
TSWTH  » .FALSE 
rONTINUE 
PFTUPN 
ENO 


,SNUM.CLSMTX(CLSNUM)  .I.SUBOESd)  .CLSSTMII) 
^T5P.AA,T72.I2.T78.AA.T«7.AI) 


HAP00760 
HAP00770 
MAP00780 
PFSULTMAP00790 
NO.'.  MAPOOBOO 
MAPOOBIO 
HAP00B20 
NAP00630 
HAP006«0 
NAPOOBSO 
MAP00660 
MAP00B70 
MAPOOBBO 
MAP00690 
MAP00900 
HAPOOVIO 
MAPOOPfO 
PAP00930 
PAP009a5 
MAP009S0 
MAP00960 
MAP00970 
MAP00980 


ciorvio 


riLPi  MCMLSK 


SUBROUTINE  HCHLSKC  KK»NV«OUHtOeT) 

OF  THF  COVAPUNCE  matrix. 

KK  > L D L* 

KK  > C0VA<>IANCF  matrix  STORED  IN  SYMMETRIC  STORAGE 

NV  ■ NO.  OF  channels 

OUM  • A WORK  area  of  SISE  NV-1 

OET  > The  OCTEMMINANT  OF  THE  COVARIANCE  MATRIX 


C 

C 


15 

12 


PFAL  KK 

hlM^NS^ON^’KKCl) 


t OUM(l) 

DOUBLE  PRECISION  TF.  R»  Rl.  OUM.  Tl 
.TRUE. 


JEl  • .1 
jT  ■ 0 

JO  ■ 0 


OET  > l.O 

LOOP  OVER  ALL  CHANNELS 


1ft  J«l.NV 
J-1 


DO 
KL 

L • J*1 
JO  > J) 

J1  ■ J1  ♦ J 
TF  » KKtJl) 

IF(Jfl)  CD  TO  12 
K1  » 0 

COMPUTE  THE  diagonal  ELEMENTS  OF  0 AND  STORE  IN  KK 
temporarily  store  the  PRODUCT  KK ( I . I ) *KK CJ. 1 ) IN  OUM III 


DO  15  1«1.KL 

R a KK(JO  * I) 

K1  a K1  ♦ I 
Pl  a KK(K1»  • R 
TF  a TF  - Rl  • R 
» Ml 

rONTlNUe 

KKUil  a TF 

fONTiNUF 

OET  a OFT  • TF 

TF  (L  .GT,  NV)  GO  TO  10 

IRO  = Jl  - L * 1 

compute  The  R»  J-TM  element  OF  L . USING  Tl 

no  20  IHa  L.NV 
IPO  a IPO  ♦ IR  - 1 
Tl  a KK(1R0  ♦ J) 

IFIJFD  GO  TO  16 
00  25  I»  1.<L 


25 

Ifl 


Ti  a Tl  - nUMd) 
CONTI  ■ 


• KKIIRD  * 1) 


INUE 

KKJTPO  ♦ J)  a TI/TF 

rONTINUF 

JFl  a .false. 

CONTINUE 

KK  contains  . IN  • •SYHETTRIC  • STORAGE.  THE  MOOIFIEO  CMOLESKY 
EACTORTTATIOM  of  TmF  input  matrix,  the  LOWER  TRIANGULAR  MATRIX.  L. 
OCCUPIES  The  OFF-OIAGONAL  FLEMFNTS  of  KK  . ANO  THE  DIAGONAL 
matrix.  0 . IS  STOWED  IN  THE  DIAGONAL  ELEMENTS  IN  KK. 

return 

END 


FILF:  PE0IF2 


SyPROUTTNE  PEniF2 (APR AY. TOPfAPRIOR.KATNO.BMATRX. PRIORI) 
IMPLICIT  INTEGER  (A-M.O-Z) 

DIMENSION  array (1) 


CALL  REOIF?( ARRAY. TOP. APRIOR.KATNO.BMATRX.PPIORI) 

ARBAY  - SEE  MONTOR 

TOP  - SEE  MONTOR 

APRIORI  VALUES  FOR  EACH  SUBCLASS 

CATKGOhy  - CLASS  CORRESPONDENCE 

h-thansformation,  IE  available 

temporary  storage  for  a priori  values 

, commons  /inform/global/class/ 

routines  F1N012.CRDSTA.GRPSCN.FLTNUM.CATSCN 

, READS  AND  analyzes  SUPER  CONTROL  CARDS 
FOR  'CLASSIFY* 

, SUPERVISOR  INFORMATION  AND  STATISTICS 


Cl 

r T 

Cl 

CT 

Cl 

• • • 

Cl 

Cl 

ftpPIOP  - 

CT 

KATNO  - 

CT 

RMATRY  - 

Cl 

PRIORI  - 

Cl 

Cl 

reouirfs 

CT 

Cl 

CT 

Cl 

PURPOSE. 

Cl 

CT 

CT 

RETURNS. 

n 

r T „ 

Cl 

C 

C 

C 

C 

C 

C 

C 


CliEND 

C 


CONTINUE 

INCLUDE  COMCiKl  .list 

COMMON/ I NFOPM/NOCLS2.NOSUP2.NOFET2.VARSZ2. TOT VT2.N0FL02. 

* AVAR?,C0VAR2,CLSI02,SU8N02.SUPDS2«FLDSV2,VERTX2. 

* EFTVC?(30)  .SUftVC?(7S)  .SLIPRTR(7S)  .CLSVC2(60)  . 

* KERPTSI^O) .NOGRP.6RPNAM<60) .GRPDEX(61) . 

* 6HHCHK(61) .6«0UPS(12A) 

COMMON  /CLASS/  APWFLG .BMCOMH.BHEEAT.BMFLG. NOCAT. ThIJI . IDATA 1 . 

* NFILE.STaTky.CATNAM(60) , 

3 CLSSYM160) .CON (60) .OET (60) .FLOESC.FLOINF (6) . 

4 KCLSNA(60) ,NOCTCL(60) .SU8CAT(60> 

* . NOCHAN. CHNVEC (30) 

CCMM0N/GL0BAL/HEA0(63) .MAPTaP.DATAPE.SAVTAP.RMEILF.BMKEY. 

* HISFIL.hISKEY.TRFORM.ERIPTP.EPPKEY.MAPUNT.NOFILE. 

* D»UMAO.r)RM«.DS.RAGSIZ.OATFlL.STAFIL.  ASAV,  ASAVFL 

* .NHSTUN.NHSTEI .SCTWUN.MAPFIL 

* .DOTUNT.DOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT, 

* CRDUNT.PRTUNT.HANOIO 


EQUIVALENCE 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


1 


(HEDl ( 1 ) .head (4)  ) . (DATE ( 1 ) .HEAD (22) ) . 
(uED2( 1) .HEAD ( 30) ) » (COMENT ( 1 ) .HEAD (48) ) 


INCLUDE  C0MHK6.L1ST 


dimension  C0DTAH(16) ,KATnO(60) 

1 . HEDl(lO).  H(-|)?(I0),  DATE(2).  COMENT(IO).  BmCOFO) 

2 , APRTOHd).  CAW02(62),  COMVEC(2) 
DIMENSION  EOUVEC(2).ACARD(20) 


REDOOOlO 
RE000020 
RED00030 
PED00Q4Q 
•IRE000050 
■IRED00060 
1RED00070 
RE000080 
IRED00090 
REDOOlOO 
REDOOllO 
RE000120 
RE000130 
RED00140 
REDOOISO 
IRE000160 
RED00170 
REDOOIBO 
PED00190 
IRE00020U 
IRED00210 
1RED00220 
IRED00230 
IRED00240 
IRED002S0 
■1RE000260 
•IRE000270 
REO002B0 
RED00290 
RE000300 
RED00310 
-RED00320 
PED00330 
RED00340 
RED00350 
RED00360 
RE000370 
RE000380 
RED00390 
RE000400 
PED004J0 
RE000420 
RFD00430 
RED00440 
RF000450 
RED00A60 
RED00470 
RED00480 
RE000490 
RE000500 
RE000510 
RED00S20 
RED00530 
PE000540 
RED00550 
RED00560 
RFD00570 
-RE000580 
RE000590 
RED00600 
-PED00610 
RED00620 
RE000630 
PE000640 
-Rf.D006S0 
RE000660 
REO00b70 
-t  Eoooeeo 
RED00690 
HED00700 
■-RE0007IO 
Petj00720 
RF000730 
-Rt.00n740 
REU00750 
RE000760 
RFD00770 
RfcD007B0 
RE000790 


oo.“>  r.  nooo  r>r>or»or»nr»oo  o r>r»  no  non 


FILFt  REnlF2 


INCLUnF  comrk?,list 

DATA  COOT AB/ •SUBC*  » ‘CHAN* , 'DATE*  » ••END*  » «COMMt , 
l»HFDl*,*HE02***OPT!*»»M0DU'*»GR0U*.»B-HA'f 
2*AP«I»»*CATE*t 'DATA* »*STAT»» 'MAPI*/ 


DATA  BLANK/*  •/,  N0CO/*N*/t  0BC0/*0*/»  SBCD/*S*/»  CBCO/*C*/ 
1 . C0«VEC/1.  •♦•  / . BMCOF/2.  'C*  . 'F*  / 

DATA  IBCO/'I*/ 

DIMENSION  SLASH(2) 
data  SLASH/1.*/*/ 


DATA  FNDCHO/**ENO*/«eoUVEC/l» •*•/ 

data  ORCO/*n*/.FeCO/*F*/,TESTB/'ILE  '/tUBCO/'U*/ 

REAL  pMATRXn).APRIOR,PM10RI(60> 

LOGICAL*!  LCHAR (4) .LLCHAH(4) 

DIMENSION  ICHA«(1) «1ICHAR(1) 

DATA  PLANKS/*  */ 

equivalence  (LCHAR(I) .ICHAR(l) ) . (LLCHAR ( 1 ) » I ICHAR ( 1 > ) 


INI7 


SYMMAX  = 60 
NF  = 0 

NOSIJH2=0 
I.  = 0 
NOrAT  = 0 
NOCLS?  = 0 
OATSWT  = 0 
nogrp  = 0 
rrdtr  = 0 

RMFLG  = 0 
APRFLO  = 0 
APRkFY  = 0 
NOCrtAN  = 0 
DO  10  1=1,60 

CATNAM(I)  = blank 
10  fJOCTCL(I)  = 0 
DO  1 1=1, SYMMAX 
APRIOR(I)  = 0.0 
1 GRPCHK(I)  = 0 

READ  SUPERVISOR  CONTROL  CARDS 


225  CONTINUE 

PUT  THE  NEXT  CARO  IN  THE  REREAD  BUFF-ER>-RQ*X 1 

RFA0(?1,2T0)  (ACAROd)  ,1  = 1,20) 

230  F0RMaT(?QA4) 

WRITE (30.230) (ACA»0( I) ,1=1,20) 

REWIND  30 

PEAD(30,??04)  C00E,CARD2 
PFWIND  30 

2204  format (44, 6X,62A1) 

COL  = 0 

WRITE (6,2206)  CODE.C4HD2 
2206  F0«KAT(T5.44,6X,62A1) 

DO  237  I = 1,16 
235  IF  ( CODE  .EQ.  CODTAB ( I > ) 

1 GO  TD  (240,250,260,270,500,510,520,530,640,560,580,590,600,610 

* 620,630),! 

237  CONTINUE 
GO  TO  1000 

SUBCLASS 


PEOjOOSOO 

RE000810 

HEOooeao 

REO00B30 
RE000840 
RE000650 
RE000860 
RED00870 
REOOOBSO 
RE000890 
RE000900 
REOOOQIO 
RE000920 
Pf 000930 
PE000940 
RE000950 
RE000960 
RE000970 
RE00098C 
RE000990 
REOOIOOO 
REDOlOlO 
RE001020 
RE001030 
RE001040 
PED01050 
PED01060 
RED01070 
RED01080 
RLD01090 
REOOllOO 
REDOlllO 
RE001120 
RE001130 
RED01140 
RED01150 
PED01160 
RLD01170 
RE001180 
RE001190 
RE001200 
RE001210 
RED01220 
RED01230 
RE001240 
RE001250 
RE001260 
RED01270 
PE001280 
PED01290 
PE001300 
RED01310 
RED01320 
PED01330 
HE  DO  1340 
RED01350 
HE001360 
RED01370 
RED01380 
REDO  1390 
PE001400 
REDO  1410 
RE  DO  14 20 
RED01430 
RED01440 
RE001450 
RE001460 
RL001470 
RE001480 
RE001490 
RE001500 
RE001510 
Pf.001520 
RE001530 
RE001540 
RE  DO  1550 
I^tu01560 
REDO  15/0 
HED01580 


FILP!  REOIF? 


2*0 


C 

C 

C 

C 

C 


M « NXTCHR(CAPD2tCOL) 

TF  ( M ,FQ.  blank  ) 60  TO  225 
COL  = COL-1 

N0SUB2  = NUMBER (CARD2» COL »SUBVC2»NOSU02) 
CALL  ORDER (SUBVC2tNOSUB2) 

60  TO  225 

CHANNELS 


250 


2'il 

252 

253 


255 


IF(  RMFL6  .RT.  0)  60  TO  225 

M r NXTCHR(  CAR02*  COL  ) 

IF  < N .EU.  BLANK  ) GO  TO  225 
J = FlN012(CARD2.C0LfEQUVEC)  . . 

IF  (J  .FO.  -1)  GO  TO  251 
TFtM  ,F0.  5^CD)60  TO  253 
IF(H  .FO.  0«CO)GO  TO  255 
WRITE (6.252) 

FORMAT (•  ERROR  ON  CHANNELS  CAROM 
RO  TO  225 

NF  = NUMBER(CARD2.CCL»FETVC2tNF) 

NOFET?  = NF  - 

CALL  ORDER (FETVC2.NOFET2) 

COL  = COL  - 1 
RO  TO  250 

NOCHAN  = number (CAR02. COL *CHNVECfNOCHAN) 
CALL  ORDER (CHNVEC. NOCHAN) 

COL  = COL  - 1 
GO  TO  250 

DATE 


C 

C 

C 

C 


2f,0  M = NXTCHR(CaRO?.COL) 

IF  ( M .EO.  BLANK  ) 60  TO  225 
READ  (30.9999)  DATE 
RFWIMD  30 

9999  FORMAT(lOX.llAA) 

RO  TO  225 


COMMFNT 


500 


CONTINtIF 

READ  (30.9999)  COMENT 
remind  30 
ROTO  225 


HEOl 


510 


C 

C 

C 

C 


rONTINU'^ 

READ  (30.9999)  HEOl 
REWINO  30 
ROTO  225 


HE02 


520 


CONTINUE 

READ  (30.9999)  HED2 
REWIND  30 
GOTO  225 


OPTION  CARO 


530 


M = NXTChR(CAR02.C0L) 

IF  ( M .EU.  blank  ) GO  TO  225 
IF  ( M .NE.  SBCD  ) GO  TO  1000 
5TATKY  =1 

M s FIN012(  CA902.C0L.C0MVEC) 
IF  ( M ,lE.  0)  GO  TO  225 
RO  TO  530 
MODULE 


RE001590 
RED01600 
REDOlbio 
RE001620 
RE001630 
RE001640 
RE001650 
REOO|660 
RE001670 
REOOiaeO 
RE001690 
RE001700 
RED01710 
RE001720 
RE001730 
RE001740 
RE001750 
RE001760 
RE001770 
REDO 1780 
RE001790 
REOOIBOO 
REDOieiO 
RED0lfi20 
RE001830 
RE001840 
RED01850 
RE001860 
RED0I870 
RE001880 
RE001890 
RE001900 
RE001910 
RE001920 
RE001930 
RED01940 
RE001950 
RE001960 
RE001970 
RE001980 
PE001990 
RE002000 
RE002010 
RED02020 
RE002030 
RE002040 
RE00205P 
RED02060 
PE002070 
RE0020PO 
RED02090 
RE002100 
RE002110 
RE002120 
RE002130 
PE0021AO 
RED02150 
RED02160 
HE002170 
REDO210O 
RE002190 
RED022n0 
RE002210 
RE002220 
RE002230 
HE002240 
RED02250 
HE002260 
■-PE002270 
RED02280 
RED02290 
REn02300 
PE002310 
PF002320 
RF002330 
RE002340 
RE002350 
PE002360 
RED02370 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


ooon  r>  o o ocxnrj  o n noon  o on  on  o non  noon 


FILFJ  PE0IF3 


540 


CONTINUE 

CALL  CPnSTA(AftPAY.TOP) 
OATSWT  r 1 
GOTO  2?5 

GPOUPS 


CONTI NUF 

I a PPPSCN(CAP02*SYMMAXt6PPTR) 
GOTO  225 

B-MATRIX  INPUT 


5«0  Hs  FIN012(C4BD2tC0L»8MC0F) 


540 


IFIM  ,FQ.  2)G0 
B-MATPIX  INPUT 

TF(M  .FQ,  3)60 
R-MATPIX  INPUT 


TO  581 
FROM  CAROS 


5801 


TO  585 
FROM  f 

code 


ILE 

CAR02 

CLSFY/REDIF2 


581 


TO  566 


582 


5H41 


C 

C 


587 

5871 


PEOO23A0 
R|002390 
PE002400 
PE002410 

srssitis 

RC002440 
RE002450 
RED02460 
PE002470 
RE002480 
PE002490 
PEU02500 
RE002510 
RE002520 
PED02530 
R|002540 
RED02S50 
PED02560 
RE002570 
PE002580 
RE002590 
PED02600 
, PE002610 

B-MATRIX  INPUT  ST 1PULATEDRED02620 

•//5X.2H* • . A4.6X»62A1 »2H* • //5X»  RE002630 

Interpret  type  of  b-matrix  input  — program  EXECREOopbAO 

FROM  REDIF2  *****/lHl)  RED02650 

RE002660 
RE0026T0 
RE002680 
RE002fi90 
RED02700 
RE002710 
RE002720 
RED02730 
RE002T40 
REn027S0 
RE00275(? 
RE002770 
RE002780 
RE002790 
PE002800 
RED02810 
RED02820 
ME002830 
RE002840 
RED02850 
RE002860 
RED02870 
REU02880 
RE002890 
RE002900 
Rt002910 
R|n02920 
PED02930 
RE002940 
RED02950 
PED02960 
RE002970 
Rtf)0?980 
RE002990 
RED03000 
WED03010 
RED03020 

WRTTE (6.586! ) CODE.  CARO?  »EOO303C 

FORMAT!////  SX.*****  CLSFY/Rfc‘nrF2  - — BAD  CARO  INPUT  OETECTEO  ON  ARED03040 
ITTFMPT  TO  WFAO  R-MATRIX  INFORMATION  AS  OIRECTEO  HY  Thf  CONTROL  CARHF003050 
20  . . . '//5X.2HI f , A4.6X.62A] .?R* *//5X, •***  TF.RMINAT1N6  PROGRAM  FXECRED03060 

3UTI0N  FROM  RLDIF2  ***•»  /IHD  RE003070 

RF003080 

CALL  FXIT  REU03090 

Rf.nn3l00 

WRTTF (6,5«71 ) PRCOMB.BmFEAT. (FFTVC2( I> .1=1 .PmFEAT)  REC031 10 

format (////sx . CLSFy/HFnrF2  B-MaTRIX  input  from  BMFILE-*RED03120 

2 //PX.'HAD  TNPur  VALOES  OFTtCTtU:  NO.  COMBINATIONS (BMCOHM)  =*.Ib.  RfO03130 
31X.«  ,N0.  CMANNFL5  (BMPEAT!  ='.I5.1X.».  CHANNEL  VECTOR  (HMVEC)  = .RE003140 
4,,*  //  < 5X.30I4)  ) REOOjISO 

WRITE (6.5872)  RE003160 


WPITE(6.580D  _ , 

FORMAT!////  5X.I4*** 
1 BY  CONTROL  CARO 
? UNABLE  TO 

3UTION  TERMINATED 

CALL,  EXIT 


B-matrix  input  on  cards 

CALL  BMFIL (RMATRX .BMC0MB.0MFEAT.FETVC2. 1 1 
NOFFT2  = EMFEAT 
RMKEY  = 1 

8MFLG  = (8MC0MR*(BMC0M8* 1 ) ) / 2 

IF(  PMFFAT  .LE.  0 .OR,  BMCOMB  .LE.  0)  GO 

N8M  = BMCOMB  BMFEAT 

IF(  NRM  ,GT.  450)  GO  TO  586 

RMFLG  = (BMCOMB  * (BMCOMBtl) )/2 


FNn  FILE 
REO^EY  = 1 

GO  TO  225 


BMFILE 


B-matrix  input  from  b-matrix  file 

CALL  RMFIL (PMATPx, BMCOMB. BMFEAT.FETVCZ. 2) 
NOFET?  = BMFEAT 


IF( 

NRM 


BMFEAT  .LE.  0 .OR, 
BMCOMB  * BMFEAT 


BMCOMB  ,LE.  0)  GO  TO  587 


IF(  NBM  .GT.  450)  GO  TO  387 
RMFLG  = ( BMCOMB  * (BMCOMB* 1 )) /2 
GO  TO  225 


ERROR  RETURNS  8-MATRIX  INPUT 


/6 


uuou  ouo  ooo 


FlLFs  REniF2 


terminating  program  execution  from  REniFZ 


587?  FORMAT!///  5X.****^ 

•CALL  EXIT 

I APRIORI  CARD  TRAINING  CLASS  APRIORI  PROBABILITY  VALUES 

' 5R0  M = NXTCHR<CARO?»COL) 

IF(M  ,NE.  FRCD)60  TO  592 
APRKEY  X -777777 

: FLAG  FOR  C0MHUTIN6  APRIOR  VALUES  FROM  STATFILE 

60  TO  596 

50?  McGYMMAX  - APRKEY 
COL  X 0 

NAPW  X aPRKFY  ♦ 1 

APPKFY  = APRKEY  ♦ FLTNUM(CAR02*C0L#PRI0RI (NAPR) «M) 

IF  (APRKEY. HE. 1)  GO  TO  596 
WRITE(6,594) 

504  fo»M4T(/T-5. •***  CLSFY/RE0IF2  - PAD  CARO  INPUT  ON  APRIORI  CARO  - 
•FAULT  APRIORI  PROBABILITY  VALUES  WILL  BE  USED.**/) 

APRKEY  = 0 

5R6  APRFLG  = APRKEY 

60  TO  225 

CATEGORY  card 


C 

c 


600 


605 


IF(NOCAT.EO.-76543?1)GO  TO  225 
LL  = NXTCHH (CARD2»C0L) 

IF  (LL.NE.FPCO)  60  TO  605 
LL  X NXTCHR (CAR02»COL) 

IF  (LL.NE.IPCO)  GO  TO  605 
NOCAT  X -7654321 
GO  TO  225 
NOCAT  X NOCAT  ♦ 1 

L X CATSCN(CARO?tKCLSNAtCATNAM(NOCAT) »L»N0CTCL(N0CAT) »NOCAT) 
60  TO  225 

data  file  card 

610  M s NXTCHR (CARD2»C0L) 

IF(M  .60.  PLANK)GO  TO  225 
IF(M  .EO.  U-^CO)GO  TO  616 
IF(M  .EG).  FBCO)  GO  TO  617 
613  WRTTF(6,753>  ^ ^ . 

753  FORMAT (•  ERROR  ON  DATA  FILE  CARD') 

60  TO  ?25 

616  J X F1N012{CAH02*COL.EQUVEC) 

IF  ( J .EO.  -1)  GO  TO  613^ 

M = NUMHEW(CAR02fC0L»DATAPE»ZER0) 

COL  X COL  - 1 
60  TO  610 

617  U = FIN012(CA«D2.COLfEOUVEC) 

IF  ( J.FO.  -1 ) GO  TO  613 

M X MJMmER (CflW02.C0L»0ATFrL»ZER0) 

OATEIL  X OATFIL  - 1 
IF  (DATFIL  .LT.  0)  OATFIL  = 0 
COL  X COL  - 1 
60  TO  610 

STAT  FILE  CARO 

6?n  M X NXTCHR(CARD?.C0L) 

TF(M  .EO.  blank) 60  TO  225 
IF(M  .FO.  U^Cn)GO  TO  625 
IF(M  .EO.  FBCO) 60  TO  627 
6?3  ^RTTF(6.7S5) 

7c;s  FORMAT!'  ERROR  ON  STAT  FILE  CARO') 

60  TO  225 

6?R  U X FINDl 2 (CARO?.COL*FOUVEC) 

IF  ( J .to.  -1)  GO  TO  623 
M X number (CAHD2*C0LtSAVTAP»ZER0) 

COL  X COL  - 1 
60  TO  6?0 

627  J X EIND12(CARn2,C0L.EQUVEC) 

IF  (J  .EG.  -1)  GO  TO  623 
M = NUMBER (CARD?. C0L*STAFIL tZEPO) 

STA'^IL  = STAFIL  - 1 
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FILE:  REniF2 


C 

C 

C 

C 

C 

C 


IF  (STAFIL  .LT. 
COL  » COL  - I 
60  TO  6?0 


0)  STAFIL  « 0 


630 


6J1 


635 


640 

64S 


650 

655 

270 

290 


615 

C 

C 

C 

c 

inoo 

10002 


rONTTNUE 
ERPKFY  s 1 

J a NXTCMR»C«R0?,C0L) 

IF  (J.EO. PLANK)  60  TO  650 
IF  ( J.NE.UfJCO)  60  TO  635 
J = FIN01?(CA«D2*C0L.EQUVEC) 

TF  {J.NE.2)  GO  TO  650 

ISTAPT  =0  . 

J s NUMBER(CAH02.C0LtMAPTAP.ISTART) 

J s FlNOl2(CAR02tCOL*EQUVEC) 

TF  (J.NE.2)  GO  TO  650 
TSTART  = 0 

J s NUMBER  (CA«D2.C0L»E«Pi<EY,ISTART) 

60  TO  225 

TF  (J.NE.ORCO)  GO  TO  640 
J = FIND12(CAR02.C0L»SLASH) 

IF  (J.N'E.2)  GO  TO  650 
J = NXTCHP(CARD2fC0L) 

IF  (J.EO.FPCO)  GO  TO  645 
TF  ( J.EO.UBCD)  60  TO  631 
60  TO  650 

TF  (J.NE.FRCD)  60  TO  650 
J = FIND12(CaRD?*C0L»E0UVEC) 

TF  (J.Nt.2)  GO  TO  650  . _ . 

ISTART  =0 

J a NUMBEP(CARD?»COL*ERPKEY»ISTaRT) 

J = FIN01?(CARD?tC0L*EQUVEC) 

TF  (J.NE.2)  60  TO  650 
ISTAPT  = « 

J = NijMBER(CAk02, COL. MAPTAP*  ISTART) 

60  TO  225 
WRITE  (6,655) 

FORMAT ( » ERROR  ON  MAPTAP  CONTROL  CARD') 

60  TO  225 
CONTINUE 
CONTINUE 

IF  (NOCAT.FO.l ) WRITE(6.615) 

’,F  (NOCaT.FO.1)  CALL  CMERR 

FORMAT (////  SX.'MUST  HAVE  AT  LEAST  TWO  CATEGORIES') 

return 

ERROR  ROUTINES 

write  (6,10002)  CODE,  CARD? 

format  (////  RX,i***«  CLSFY/PF.DIF2  — flftD^P59CESSOR  CONTROL 

in  . . . • //5X ,?H • « , A4, 6X ,62A i , ?H • • //5X, '•***  terminating  program 

2ECUTI0N  FROM  REDIE2  ****'/lHl) 

GO  TO  225 

END 
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file:  reler« 


FUNCTION  RFLEPP(COVMTX«  COV»  NOFETPt  VARSZP) 

INTEGFR  VARSZ? 

COmmon/SCRACh/SCRI (?n00) tSCRP ( 10SO0> 
dimension  0(30) » C0V(VARSZ2)»  C0VMTX(VARSZ2) 

PEAL  LUL(A65) 

EQUIVALENCE  ( ENORMO,  SCR2(I))t  ( ENORHOt  SCR2(2))  * 

1 ( 0(1).  SCR2(3)).  ( LDL(l).  SCR2(33))» 

? ( SUM,  5CR2(963)),  ( II,  SCR2(964)),  ( I,  SCR2(965)). 

3 ( J.  SCR?(9frN)).  ( L.  SCR2(967)).  ( JJ.  SCR2(9N8))« 

A ( KK,  SCR?(9()9)),  ( JK,  SCR2(970)),  ( NP,  SCR2(97D). 

5 < III,  SCR2(972))^  ( IJ,  SCR2C973)),  ( JP,  SCR2(97A)), 

6 ( IP,  SCR?(975)) 

COMPUTE  THE  EUCLIDEAN  NORM  OF  THE  COVARIANCE  MATRIX,  BEFORE 
cholesky  Factorization 

FNORMO  a 0.0 
no  Igl  l=1,vaRSZ2 
Ifll  ENORMd  a ENORMO  ♦ 2.0  * COV(I)  * COV(I) 

c 

II  = 0 

no  18?  I=1,N0FET2 
II  = II  ♦ I 

ENORMO  a ENORMO  - < COV(II)  * COV(II)  ) 
n(I)  a COVMTX(II) 

18?  COVMTX(II)  a 1.0 

c 

ENORMO  a SORT (ENORMO) 

C 

IJ  a 0 

no  187  Ia).N0FET2 
IK  a I 

II  = ( IK  * (IK-1)  )/? 
no  186  J=1,IK 

JK  a J 
SUM  = 0.0 

JJ  a ( JK  * (JK-1)  )/2 

rO  185  KPal.JK 

KK  a KP 
JP  a JJ  ♦ KP 
IP  a II  ♦ KR 

185  SUM  a SUM  ♦ ( COVMTX(JP)  * COVMTXdP)  * D(KP)  ) 

IJ  a IJ  ♦ 1 

186  LnL(lJ)  a SUM 
C =L  ♦ 0 ♦ L* 

187  CONTINUE 
C 

II  a 0 

no  188  L=1.N0FET2 

II  a II  ♦ L 

188  rovMTXd  I)  a 0(L) 

FNORMO  a 0.0 

III  a 0 
II  a 0 

no  190  Iai,NOFET2 

II  a II  ♦ I 

no  1«9  Jal.I 

III  a HI  ♦ 1 

SUM  = COVdIl)  - LOLdll) 

IPO  FNORMO  a ENORMO  ♦ 2.0  * SUM  ♦ SUM 
8IJM  = covdl)  - LOLdll 

190  ENORMO  a ENORMO  - ( SUM  * SUM  ) 

c 

IF  ( ENORMO  .LF.  l.OE-8)  GO  TO  191 
ENORMO  a SORT (ENORMO) 

C 

191  REI.  ERR  a ENORMO/ENORMO 
RETURN 

ENn 
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FILE  SCTUP2 


CSENO 


SURROuriNC  SETUP2(ARRAYtT0PtFL0FL6tAPRI0R*BHATRXtKATN0)  SETOOOll 

iMPLICiT  INTEGFR  CA-H.O-Z»  SET0002I 

REAL  CON*OET«BMATRX*APRIORtNORM  SET0003I 

• *APRltAPRI0«PR10Rl  SET0004I 

. SETOOOSI 

DIMENSION  ARRAY ( 1)  •PRIORK60)tVERTCS (22)  SETOOr 

S|T00( 
ISETOOOSI 
isETOOORI 
fSETOOlOl 

CALL..  CALL  SETUP2(ARRAY«T0P*FL0FL6«APRI0R*BMATRX*KATN0) 

ARCS..  ARRAY  - SEE  MONTOR  SETOOll 

TOP  - SEE  MONTOR  flTOOlAI 

FLDFLG  - SET0015L 

APRIOR  - aPRIORI  values  for  each  subclass  SET00I60 

BMATRX  - B-THANSE0RMAT|0N  MATRIX,  IF  AVAILABLE  SETOoItO 

KATNO  • CATEGORY  - CLASS  CORRESPONDENCE  SETOOlsS 

iSETooioo 
ISET00200 

REQUIRES.  COMMON  /INFORM/CLASS/GLOBAL/  SET00210 

SET00220 

ROUTINES  FIND12,RED1F2,RE0SAV  SET00230 

ISET00240 

PURPOSE  ANALYSIZE  SUPERVISOR  INFORMATION  ISETOoHo 

ISET00260 

RETURNS..  SUPERVISOR  INFORMATION  AND  REDUCED  STATISTICS  ISET00270 

FOR  PROCESSING  1SET00280 

ISET00290 
!setoo3o6 
ISETOO310 
SET00320 
SET00330 
SET00340 

CONTINUE  SET00350 

INCLUDE  COMBKlfLIST  SET00360 

SET00370 

SET00380 

EQUIVALENCE  (OATEU),  HEAD (22))  SET00390 

SgroOAOO 

...... SET00410 

SET00420 

INCLUDE  C0MRK2«LIST  SET00430 

SET00A40 

SET00450 

SET00460 

SET00470 

... ..... .... .... SET00480 

SETOOA90 

SET00500 

... ... SET00510 

SET00520 

5ET00530 

INCLUDE  C0MBK6,LIST  SET00540 

COMMON/ INF0RM/N0CLS2, N0SUR2,N0FET2,VARSZ2. TOT VT2»N0FLD2,  SFT 00550 

• AVah?,C0VAR2,CLSID?,SUBN0?,SUB0S2.FL0SV2»VERTX2»  SET00560 

• FETVC2(30> .SURVC2(75) fSU«PTW(75) ,CLSVC2(60) » SET00570 

• KFMPTS(60I ,NOORP,6RPNAM(60) »GRP0£X(6l)»  SET00580. 

• 6RPCMK(61) .GR0UPS(124)  SET00590 

COMMON  /CLASS/  APPFLG.BMCOMR ,RMFE AT ,6MFL6,N0CAT , THI J1 , lOATAl » SET00600 

• NFIlE,STATKY»CATNAM(60» , SETOOGIO 

3 CLS5YM(f,n),CON((S0),DET(60),FLOESC»FLDINF(6),  SET00620 

4 KCI.5NA(60)  »NOCTCL(60)»SUBCAT(60)  SET00630 

• .NOCHAN.CHNVEC (30)  SET00640 

C0MM0N/GL08AL/Ht A0(63) ,MAPTAP,DATAPE,SAVTAP»BMFILE»BMKEY,  SET00650 

• HISFIL»HISKEY.TPF0RM,EPIPTP,ERPKLY»MAPUNT,N0FILE,  SET00660 

• nRUMAD,DRMWIiS.PA6SI7fnATE IL.STAFIL.ASAVtASAVFL  SFT00670 

• ,NHSTUN,NH5TFI ,srTRUN,MAPFIL  SET00680 

• ,1)0TUNT,i)0TFIL.NCHPAS.TRNSFL»HMTRFL,HISTFL»PCHUNT,  SFT00690 

• CRDUNT,PRTUNT»PAN0I0  SET00700 

SET00710 

DIMENSION  0ATF(2)  ,FILVEC(2)  .APRIORd)  ,XATN0(60)  SET00720 

DIMENSION  CARD(42) ,CLSSY(60)  SET00730 

5ET00740 

DATA  YBCO/'T*/,  NPCO/'N'/,  MOOflCD/'MOOU*/ » BLANK/*  */,  SET00750 

1 FILVEC/  1 t *F*  / SET00760 


\ 


noooo 


FILE  SET0P2 


DATA  EN0BC0/»SEN0»/  Sf 

DATA  CLSSY/*l«.»2»#»3#»iA*,«*}t*»fit*7*»*8‘t»9*t»A»f S|i 

9 •M't'S'f  •T*«*U*f  •V't'W't'X't'Y't'ZP'.'tM't'**'**/**  SETOOPO 

3 •••,#$!, nil, I •,i.i,iTi,i)i,i(i,it<*  SET0081 

A iAi,i>i,i|i,i?i,i  i,i,i,i.*,«  I / SE 

DO  5 I>1«60  SE 

5 CI.SSYH(t)>a.SSY(n  SE 


DIMENSION  BHATPX(RMC0HB«BHFEAT) 


SETO 
SET009 
SE 


NOCLSSaO 
FILEOP  ■ 0 

GO  BEAD  SUPERVISOR  INFORMATION 


CALL  RE0IF2( ARRAY, TOPiAPRIORiKATNOiBMATRXiPRIORI) 


GET  TAPE  READY 


REWIND  HAPTAP 
NFILE  * ERPKEY 
IF  (NFILE. LE.OI  NFILE  ■ 1 
ISKIP  a NFILE  - 1 
IF  (ISKIP. LF.O)  GO  TO  AOO 
CALL  FSBSFL(MaPTAPiISKIP,ISTAT» 
IF  (ISTaT.NE.O)  call  EXIT 
CONTINUE 


CALL  ROUTINE  TO  REDUCE  THE  ARRAYS 


CALL  REDSAV( ARRAY, TOPiBMFLGI  | 

TEST  FOR  CATEGORY  *FILE»  INPUT  -IF  SO  FORM  CATEG0RY/CLASS/SUBCLA5SS 

ASSOCIATION  USING  CLASS/SUBCLASS  INFORMATION.  § 

IDUM  a -76S4321  S 

IF(NOCAT.NE.IOUM)GO  TO  406  S 

FILEOP  -I  S 

NOCAT  = NOCLS2  S 

00  405  I=liN0CLS2  S 


P=CLSI02  ♦ I -1 
CATNAM(I)  s ARRAY(P) 

NOCTCL(I)  ■ 1 
KCLSNA(I)  3 array (P) 

405  CONTINUE 

406  CONTINUE 

* default  — SAME  CHANNELS  AS  SELECTED  FROM  STAT  FILE 

I 

IF  (NOCHAN  .NE.  0)  GO  TO  335 
DO  330  IsI.nOFET? 

330  CHNVEC(I)  3 FETVC2(I) 

NOCHAN  3 N0FET2 
335  CONTINUE 

COMPUTE  BASE  ADDRESSES  FOR  5CRACH  ARRAY 
THIJI  - BASE  ADDRESS  FOR  TABLE  COMPUTED  IN  THRESH  CONTAINING 
CLASS-PAIR  THRESHOLDS 


v;-) 


OP 


O’, 


O' 


riLE  SETUP2 


(I 


AlG’f 


^ Is 


lOATAl-  BASE  ADDRESS  FOR  DATA  PASSED  BACK  FROM  TAPERD 

ThIJI  ♦ (N0SUB?*l)*(N0SUB2>2)/2  ♦ N0SU82 
r .6T.  0)  lOATAl  « 1 

STORE  A BLANK  IN  DEFAULT  SYMBOLS*  THIS  WILL  BE  USED  IN^_ 
PRINTING  THE  MAP  CLASSIFICATION  FOR  THE  UNCLASSIFIED  PIXEL 

CLSSYM(N0SUB2  * 1)  « BLANK 
IF  <NOCAT  .LE.  0» 


SET01S30 
ioIIm 


60  TO  A6S 


ALL  CLASSES  MUST  BE  ASSIGNED  TO  A CATEGORY 

DO  *10  Ilal.NOCAT 
♦ 10  NOCLSS  = NOCTCLUl)  ♦ NOCLSS 

IF  ( NOCLSS  *EO.  N0CLS2  ) 60  TO,  *15 
WRITE(6»*50) (ARK«Y(CLS102*1-1) «|al*N0CLS2) 
hR!tE(6»*60) (KCLSNA(l) *l«l*NOCLSSf 
CALL  CMERR 

SET  UP  KATNO  array  TO  CONTAIN  THE  CATEGORY  EACH  CLASS 
BELONGS  TO 

♦15  CONTINUE 


[oi60( 


[to  U\ 
TO  67( 
-JTO  6BC 
SfTO  6»« 
SEto  7r 


NOCLAS 
00  *3S 


■ 0 

l>i«nocat 


NOCLSi  » NOCLAS  ♦ 
NOCLAS  « NOCTCL(L) 


1 


♦ NOCLSI  - 1 

JeNOCLSl. NOCLAS 
KCLSNAtJ) 

K*1»N0CLS2 

--  ARRAY(CLSI02-1*KM 


GO  TO  *30 


00  *25 
CLSNAM 
DO  *20 

IF  (CLSNAM  .EQ. 

*20  continue  3C)u 

**0  WRITECb.ASO) (AR«AY(CLSID?*1-1) »Ial*N0CLS2) . ^ 

*50  FORMAT (//  • AN  ERROR  HAS  OCCURRED  IN  GROUPING  CLASSES  INTO  CATE60RSETO 
•lES. CHECK  THE  FOLLO*)ING  :•//  5X*»1.  NOT  ALL  OF  THE^^CLASSES  HAVE  BESETO 


SBO 

*90 


♦EN’aSSIGNEO  to  a CATEGORY.*/  5X.  *2.  A CLASS  NAME'ON  THE  CATEGORY  SETOlsIS 
•CARO  HAS  BEEN  MlSSPELlfEO.J//  lOX,  ^CLASS  NAMES  FfiOM  SAVTAP  FILE  ARS|T01930 


•E  : • / 5X,  (10(A6.2XJ )) 

WRITE(6. *60)  (KCLSNA(l)  ,1*1. NOCLSS) 

*60  FORMAT!  / lOX.  'CLASS  NAMES  FROM  CATEGORY  CAROS  ARE  : •/  5X* 

• dO(A***X)  ) ) 

CALL  CMERR 

*30  KATNO(K)  ■ L 
*25  CONTINUE 
*35  CONTINUE 

SFT  UP  SUBCAT  ARRAY  TO  CONTAIN  THE  CATEGORY  EACH  SUBCLASS 
BELONGS  TO 

DO  *37  II  » 1.N0SUB2 
CLSNUM  = CLSVC?(II)  . 

*37  SUBCAT (II)  « KATNO(CLSNUM) 

*65  CONTINUE 

[ PRINT  OUT  THE  SUPERVISOR  INFORMATION 

' WRITE(6»HEA0) 

WRITE(6,5012) 

IF  ( STATKY  *F0.  1 ) WRITE (6,501*) 

IF  ( NOCAT  ,GT.  0 ) WRITE (6,S01«) 

IF  ( NOCAT  .LE.  0 ) WRITE (6.5020) 

IF  (FILEOP.EU.I ) WRITE(6,S022) 

sol?  FORMAT (T2» 'THE  FOLLOWING  OPTIONS  HAVE  BEEN  SELECTED*/) 

SOI*  F0RMAT(T5, 'PRINT  MULTISPECTHAL  STATISTICS;*) 

501B  FORMAT  (TS, 'CATEOORY  CLASSIMER  OPTION  HAS  BEEN  SELECTED.') 
5020  F0RMAT(T5. 'STANDARD  CLASSIFIER  OPTION  HAS  BEEN  SELECTED.') 
5022  format (T7. 'ALSO  CLASSES  FROM  STATFILE  WILL  BE  CONSIDERED  THE 
•DRIES  F()H  CLASSIFICATION') 

SO?  FOPMAtV^//  IX. 'SUPERVISOR  information  : '//TS.'FILE  NUMBER  ., 

• 110/  ts.'no.  of  fields ', 


SET019A0 
SETO 1950 
SET01960 


SETO 

SETO 

SETO 


1970 

19B0 

990 


SET02000 

SET02010 

SCT02020 

SET02030 

SET020*0 

SET02050 

SET02060 

SET02070 

SET02080 

SET02090 

SET02100 

SET02110 

llJIllfl 

SETO2l*0 

SET02150 

SET02160 

SET02170 

SET02180 

SET02190 

SET02200 

SET02210 

SET02220 

SET02230 

CATEGSET022*0 

SET02250 

5ET02260 

..*,  SET02270 
SET02280 


/7J 


riLf  SETUP2 


8 

C 


2 16/T*i«»N0.  OF  CLASSES. I * SUBCLASSES. 

1 lA/TSt'NO.  OF  CHAMn€LS....»»«'»iA^////) 

IF  (APRFL6  .LE.  0 ) GO  TO  GOAS 

normalize  apriori  values  that  mere  input  by  user 


\m 


60A1 


NORM  ■ 0.0  . ^ 

00  AOO  IbI.APRFLG 
600  NORM  ■ NORM  ♦ *6% (PRIORI (I) » 

?F  ( NORM  ,LT.  .V9R9V9  ftOft'aNORM  .6T.  I.OO 

TKU'S(irNK!!,iS8’.5.?"'“"  “ 

603  Priori (i>  ■ 

— (APRFLO  .FO.  N0SUB2  00  TO  610 
APHFLG  .EO.  N0CLS2)  50  TO  620 
APRFLO  .EG.  NOCAT)  60  TO  630 


input! 


IP  < 

F ( 
F ( 


6010  FolMATt^l* •••  ERROR  IN  A PRIORI  CONTROL  CARD.  USER  INPUT  VALUES 


\ 


•NQREO.  •••) 

60  T()  6065 

APRIORI  VLAUES  INPUT  BY  SUBCLASSES 


610  00  615  1»1.N0SUB2  .. 

615  APRIOR(I)  b PRlORl(I) 

6015  F0RMAT*T5?'*» APRIORI  VALUES  INPUT  BY  SUBCLASSES 
GO  TO  6070 


•» 


APRIORI  VALUES  INPUT  BY  CLASSES 


620 


625 


JJ  ■ 0 

00  625  iBl.NOCLSg  . 

NOCL  * ARRAY  <SUBN02-1*I)^_,  , 

APRI  « PRIORI (I)  / FLOAT (NOCL) 

DO  625  JsT.NOCL 
JJ  B JJ  * 1 
APRIOR(JJ)  • APRI 

6025  F0RMAnT5?^** APRIORI  T^PUT  BY  CLASSES. 

•)  APRIOR  / (NO.  SUBCLASSES  IN  CLASS(J))  •) 

GO  TO  6070 

^ APRIORI  VALUES  INPUT  BY  CATEGORIES 

gb^22o-  ^.1, NOCAT 
APRI  B PRIORI (I) 

II  B NOCTCL(l) 

M B 1 

NOSBCL  a 0 

DO  6*5  Xal*ll^^. 

DO  6*0  KKB1.N0CLS2  etna  i.virtt 

IF  (KCLSNA(K*CLSNM)  .EO.  ARRAY (CLSID2-1*KK) ) 

NOSBCL^a  ARRAY  (SUf)N02-l*KK)  * NOSBCL 
APRIO  « APRI  / )-L0AT  (NOSBCL) 
lO  650  KKKsl.NOSURZ 
F (I  .EO.  SURCaT(KKK)) 

F ( { .lo:  SUBCAT(KKK)) 

F (M  .67.  NOSBCL)  GO  TO 


APRIOR (I) 


GO  TO  645 


6*0 

645 


650 

655 

660 

6060 


A 

! 


APRIOR(KKK) 
M B M * 1 
655 


APRIO 


CONTINUE 
CLSNM  « CLSNH  ♦ II 
CONTINUE 
WRITF(6.6060) 
format (T5«  'APRIORI 
•RY(J)  APRIORI  / (NO. 
GO  TO  6070 


VALUES  INPUT  BY  CATEGORY. 
SUBCLASSES  IN  CATEGORY (J)) 


APRlORdl 

•) 


'60*5  IF (APPFLG.PO. -777777)00  TO  760 
FLAG  POR^SAVTAP  COMPUTATION 
IF  (NOCAT. LF.  0)  GO  TO  605 


‘^‘-^^"‘iETO 

||t0|74- 
SET02750 
5fT02760 
SET0277P 
SET02780 
SET02795 

liroP?8 

sn02«20 
SET02B30 
SET0284‘ 
IT0285 
ST0286 
£T6287 
SET0288. 
SET0|890 
SET0?900 
SET029iO 

|fT02930 

irTgfi^ 

SET02966 
• CATE60||T0|975 
SFT02980 
SET02990 
SET03000 
SET03010 

IHSiSlI 

SET03040 


fiLif  setup* 


, OAT (NOCAT) 
*.AT 


coMPute  oerAuuT  appiori  valuse  for  catcoory  classifier 

CL5NM  • 0 

DO  7SO  !«1*N0C( 

Yl  •.NOCtCL(I) 

0 

K«1«1I 
KKaltNOCLS* 

(KeiSNA(K«CLSNMT  .CO.  ARRAY(CLSI02-1«KK) ) 00  TO  71S 

70S  Continue 

71S  NQSRCL  ■ ARRAY(SURN0*«I«FK)  • N05BCL 
APPIQ  ■ APRI  • A*0  7 FLOAT (NOSBCL) 

00  720  KAKal.NOSyP* 

F ( I .CO.  SURCAI(KKK)  ) APRIOR(KKK)  ■ APRIO 
F I I .EO.  SUBCaTIKKK)  t H ■ N ♦ 1 
F(  M .OT.  NOSBCL)  GO  TO  740 
ONTINUE 

LSNH  ■ CLSNM  ♦ II 
ONTINUE 
0 TO  6G53 

COMPUTE  APRIORI  VALUES  FROM  STATFILE 

TKEPTS  » 0 
00  765  1«1.N05UB2 
TKCPTS  « TKEPfs  ♦ KCPPTSII) 

TOTAL  ALL  SUBCLASS  PIXELS 
DO  770  T « 1.N0SUB2 

APPlOWCl)  « FLOAT (KEPPTS(I) »/FL0AT(TKEPTS) 


[030S( 


CONTINUE 

IPaT  « STAFIL  *1  . 
rfWITE  (6,775)  IPAT 


. . APRIORI-  NO. 

LS  IN  SURCLA§S/fOTAL  NO.  PIXELS  IN  ALL  SUBCLASSES  ••••) 


i 

C 


605 

606 

C 

C 

6050 

6053 

6055 

'6070 

,607 

>00 

AOO 


c 

c 


FORHaKTS, 'APRIORI  VALUES  FROM  ST  ATF ILE  • , I 3,  • 

•XELS  IN  SURCLASS/t  ‘ ' 

GO  TO  6070 

COMPUTE  DEFAULT  APRIOR  VALUES  FOR  STANDARD  CLASSIFIER 

NORM  > 1.0  / FLOAT (N0SUB2) 

DO  606  i-l.N0SUB2 
APRIOR(i)  > NORM 

HRITE(6.6050) 

format (T5, 'DEFAULT  APRIORI  PROBABILITY  VALUES  HILL  BE  (JSEO. 
•ASS(I)  - 1.0/(NO.  OF  SUBCLASSES)') 

GO  TO  6070 

COnt|nue^^^^^ 

FORMAT aS^^DFFAULT  APRIORI  PROBABILITY  VALUES  FOR  SUBCLASS!! 
•0/(NO  OF  CaTEG0«IES)*(N0.  OF  SUBCLASSES  IN  CATEGORY (U) • ) 

APRFLG  a NOSUH?  

WRITE (6,502)NFILf ,NOFLD2,NOCLS2.NOSUB2.NOFET2 
IF(  BMFLG  .LE.  0)  GO  TO  700 

CALL  HRT8M(BMATRX.BMC0MB»BMFEAT.FETVC2) 

CONTINUE 

IF  (NOCMAN  .NE.  JOFET?)  HRITE(a.BOO) 

format ('  NO,  OF  CHANNELS  REQUESTED  FOR  DATA  TAPE  AND  NO.  OF 
•LS  ON  STAT'/'  FItL  MUST  BE  EQUAL') 

IF  (NOCMAN  .NE.  N0FET2)  CALL  CMERR 

WRITE  FIRST  RECORD  ON  THE  CLASSIFICATION  RESULTS  OUTPUT  FILE 
MAPTAP 


HEADER  RECORD  NO.  1 FOR  MAPTAP 


5!tO 
SETO^ 
i|To3. 

ysi,, 

SET03320 

SET03330 

SFT03340 

SET03350 

SET03380 
PI  SET033R0 
5ET03400 
Se 103410 
SFT03420 
SET03430 
SET03440 
SET03450 
SET03460 
SET03470 
SET034B0 
5ET034R0 
SET03500 
SUBCLSET03510 
SET03520 
SET03530 
SET0354d 
SET03550 
) « 1.SET03560 
SET03S70 
SETOSSBO 
SFTC3S90 
SET03600 
SET03610 
SET03620 
SET03630 
SET03640 
SET03650 
SET03660 
SET03670 
CMANNES|T0^6|0 

SFT03700 
— SET03710 
SFT03720 
SET03730 
SET03740 
SFT03750 
— SET03760 
5ET03770 
SET03780 
SFT03790 
SET03600 


riLC  SCTUP2 


aso 

sooo 

i 

900 


WRITE (MAPTAP) (DATf ID  *8MrL6*BMC0MR*BMreATf N0CLS2* 

N0FLn?tN0SUW?*N0FET2«T0TVT?*N0CATiVAPSZa» (FETVCZI D • I>1 t 


NOF 

IfinoclS2.gt.i)go  to 
WRlTEloisopO) 


T2» 

12.GT.DG0 


TO  9J|^ 


RT( 

0 


FLOINFtNC) 


FORMAT l//,Ix»»STAT5  INPUT  FOR  ONE  CLASS.  NO  CLASSIFICATION* • 

• attempted. »» 

w 


oooorirM^ 


FILFi  setus 


fUBPOUTlNF  SETUS (AVFVTX*C0VMTXt0U0*HCANtC0V*NCMAN»N0CLS2* 
•VA»S7?.JJ) 

USING  The  lOWFR  TRIANGULAR  MATRIX  ANG  DIAGONAL  MATRIX  FOR 
CLASS(JJ»  IN  COVMTX.  The  FULL  COVARIANCE  MATRIX  FOR  CLASS(JJ)  IS 
C6MPUTFD,  AS  L X 0 X L*  f ANO  RETURNED  IN  COV 
ALSO.  TmF  MFAN  vector  for  class (JJ)  is  extracted  FROM  AVEMTX. 

ANO  IS  RETtJRNED  IN  MFaN 


C 


c 


c 


integer  ROW.COL.VARSZ2 

REAL  MFAN(NCMAN) 

OIMENSION  COV(NCHAN.NCMAN) 

Of‘*ENSION  AVEMTX (NCHAN.NOCLSZ) tCOVMTX (VARSZ2.NOCLS2) .01 AG  INCHAN) 


NI  « 0 
N2  * 0 
00  2 R( 


ROW 

Nl  * Ni  * 
Dl«G(ROw) 

MFAN (ROW) 
COVMTX (NI . JJ) 


'^.NCMAN 


COVMTX (Nl.JJ) 
AVEMTX (ROW.JJ) 
1.0 


00  5 ROW  » 1 .NCHAN 

TI  » (ROW  • (ROW  - 1) ) / 2 

00  A COl  a 1 .ROW 

SUM  3 n.o 

JK  » (COL  * <COL  - D)  / 2 
00  3 A = l.(!OL 
JR  * JK  ♦ A 
TP  » n ♦ K 

3 5UM  = SUM  * COVMTX (JP.JJ)  • COVMTX ( IP. JJ)  • 01A6IK) 
COV(ROw.COL)  a SUM 

A cov(col.row)  c sum 

S CONTINUE 


hh  6 COl  a 1.  NCHAN 
II  a II  . CGL 

6 COVMTX ( 1 1. JJ)  a DIAG(COL) 

return 

Eno 


nn  nnooonr>nnr»oooonoonr>noonor>r»r>noooonr)r)onr>r)r»orinr>nor>r>nr)r>rir>or>or>or)Oor>or>oor>r>oor»r>r>r> 


file 


THRESH 


SURROUTINE  thresh (N0CLS2.N0FET2.NPL1 ♦ APRIOR. AVEMTX .COVMTX .OET , 
1 VARSZ2.S1.S2.U1.U2.0B.OIAG.THIJ) 


SURROUTINE  THRESH  COMPUTES  THE  CLASS-PAIR  THRESHOLDS  . AND  RETURNS 
THEM  IN  • ‘SYmETTRIC*  • STORAGE  ( THIJ)  IN  THE  F0LL0V(IN6  MANNER: 


2,1 

3.1 

3.2 

4,1 

4,2 

4,3 

5.1 

5.2 

5,3 

5,4 

6.1 

6.2 

6,3 

6,4 

6.S 


THRESH  REQUIRES  THE  FUNCTION  SUBPROGRAM,  G ( WITH  ALTERNATE  ENTRY 
POINT,  GG  ),  AND  The  SUBROUTINE  FALSY  . 


COMPUTATION  OF  THE  CLASS-PAIR  THRESHOLDS 


FOR  U1  = MEAN  VECTOR,  CLASS(l)  OF  THE  CLASS-PAIR 
U?  = • * • • . CLASS(2)  • • • • • ' ♦ • 

COVl  = COVARIANCE  matrix,  CLASS(l)  OF  THE  CLASS-PAIR 
COV?  = *•  ••  , CLASS(2>  ••  ••  •• 

Cl  = ? * LOG  APRIORI (CLASS  1)  - LOG  DETERMINANT (CLASS  1) 

C?  = ? * LOG  APRIORI (CLASS  2)  - LOG  DETERMINANT (CLASS  2) 
AND 

C - C2  - Cl 

(1)  IF  Cl  ,LE.  C2  - (U1-U2)*  X C0V2**-1  X (Ul-U2> . THIJ=  Cl 

(2)  IF  C2  ,L£.  Cl  - (U1-U2)*  X C0V1**-1  X (U1-U2) , ThIJ*  C2 

(3)  IF  neither  (1)  NOR  (2),  COMPUTE  THE  CLASS-PAIR  THRESHOLD 
ITERATIVELY  AS  FOLLOWS: 

FIND  A NUMBER,  0 ,GE.  X .LE.  1 . SO  THAT  THE  SOLUTION  VECTOR. 

H(X),  OF  THE  system  of  EQOATIONS. 

(3A)  ( (1-X)*  C0VI**-1  ♦ X ♦ C0V?**-1)  * H(X) 

= (1-X)  * C0V1**-1  * 01  ♦ X * C0V2**-1  • U2 

ALSO  satisfies  G(  H(X)  ) = C2  - Cl  . WHERE 

(3P)  G(  H(X)  ) = ( H(X)  - U2)«  * C0V2**-1  * ( H(X)  - U2) 

- ( H(X)  - UD*  * C0V1**-1  * ( H(X)  - U1  ) 


SUBROUTINE  FALSY  OETFRMINES  3-pQINT  INTERVALS  IN  THE  RAMGF . 

0 .r-E.  X .LE.  1 , FITS  A QUADRATIC  0(X)  TO  THE  THREE  POINTS  ANO 

OBTAINS  THE  ROOT,  X , FOR  Q(X)=  C2-CI.  THE  ROOT.X  . u.  THIS 
QUADRATIC  APPROXIMATION  OF  G(  H(X)  ) IS  SENT  TO  FUNCTION  6. 

FUNCTION  6 obtains  THF  SOLUTION  VECTOR  , H(X),  FOR  THF  SYSTEM 
OF  FOUATICNS  (3A)  . ANO  APPLIFS  ThF  H(X)  TO  OHTaIN  THF  VALUE 

OF  G(  M(X)  ) (EON.  33).  FALSY  TESTS  ThE  VALUE  OF  G(  H(X)  ) 

IN  RFLATIO.N  to  C?-C1  .wIThIN  a PRF-SET  tolerance  on  the  RESIDUAL. 
IF  G(  H(X)  ) .NE . C?-C1  * TOLEWANCE.  ITERATION  CONTINUES  IN 

FALSY  WITH  NEW  intervals.  QUAOPATIC  FIT  OE  THE  INTERVALS,  ROOT 
OF  THF  APPi^QxIMATING  quadratic  SENT  TO  FUNCTION  G.  FALSY 
RETURN'S  TO  THRESH  WHEN  A ROOT.  X , OF  THE  ARRROX  IMAT  I NG  QUADRATIC 
IS  FOUNO  WHICH  yields  an  H(X)  THAI  SATISFIES  G(  H(X)  ) = C2-C1 
WITHIN  THE  PRE-SEI  TOLERANCE. 

THRPSH  (.OMPUTFS  ThE  CLASS-PAIR  THRESHOLD.  THU.  BY  OBTAINING  FROM 
G TE.E  EVALUATION  OF  G(  H(X)  ) FOR  THE  X RETURNED  HY  FALSY  : 

THIJ  = .5  « ( Cl  - ( H(X)-  UD*  * C0V1**-1  * ( H(X)-Ul)  ) 


integer  VAhsZ? 


THPOOOlO 

THR00020 

THRO0030 

THROOOAO 

THR00050 

THR00060 

THR00070 

THROOO0O 

throooro 

THROOIOO 
THROOl 10 
THR00120 
THR00130 
THROOIAO 
THROOISO 
THR00160 
THR00170 
THROOISO 
THR00190 
THR00200 
THR00210 
THR00220 
THR00230 
THR00240 
THR00250 
THR00260 
THR00270 
THRO02P0 
THR00290 
THR00300 
THP00310 
THR00320 
THR00330 
THR003A0 
THR00350 
THR00360 
THR00370 
THRC0380 
THR003P0 
THR00400 
THROOAlO 
THR00420 
THR00430 
THR0C440 
THR004SO 
THRO04H0 
THR00470 
THR004BO 
THR00490 
THR00500 
THR00510 
THR00S20 
THR00S30 
THRO0S4O 
THROOS50 
THROOS60 
THRP0S70 
ThPOOSSO 
THRO0S9O 
THR00600 
THR00610 
THRO0b20 
THROn630 
THW00t40 
ThPOObSO 
THR00660 
THRO0b70 
ThROObSO 
THROObRO 
THR00700 
THR00710 
ThhoO/20 
TMW00730 
TRH00740 
THHn07S0 
THRf)07bO 
thro  07 7 0 
TfiR007«0 
TMR00790 


/7? 


n or>o  ooo 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


FtLF:  THRESH 


niMENSION  THlJd) 

OI“ENSION  iVEHTx (NOFET^.NOCLS?) t COVMTX < VAHSZ2.N0CLS2) » 

1 SI  <M0FET2.N'0EET2)  »S2  (^JOFET^.NOFtT^)  . DUG(N0FET2)  t 

2 APPI0R(N0rLS2)  t UKN0FET2).  U2(N0FET2)t  DET(N0CLS2)  . 

3 BRtNOFFT?«NPLl) 


K = NOFFT? 

KPl  = NWLl 

DO  F-(S  1 = 1.N0CLS? 

TAT  = P.O  « ALDG(  APRIOP(I)  ) 

CALL  SFTUS(  AVF^'TX,C0VMT^X,DIAG.U1.S1.N0FET2»N0CLS2»VARSZ^.1) 
ni  = ALOG(  nET(l)  ) 

00  6%  j=i.Gori.s? 

TAJ  = 2.0  * ALn^(  APRIOR(J)  ) 

CALL  SETUS ( AVEPTX  tCOVMTX.OI A6»U2tS2*N0FET2tN0CLS2,VARSZ2»J) 
D2  = AL0G{  DET(J)  ) 

C = 02  - 01  ♦ 2.0  * AL0&(  APMI0P(I)/APRI0P(J)  J 
KT  = 0 

IF(J.EO.I)  GO  TO  65 

COMPUTE  TME  symmetric  MATRIX  STORAGE  LOCATION 
class  I-J  pair  ThHESMOLO  VALUE 

JMl  = J - 1 
JM?  = J - 2 

NTH  = ( JMl  * JM2)/2  ♦ 1 
XL  = 0. 

XU=1.0 

GO  = GrxL.Sl.S2.Ul ♦U2.83,Ki tT.K,KPl) 

Gl  = G(  aj.Sl  tS2*Ul  »U2»BK..n' »T,K,KP1> 

TFIGO.GT.O  GO  TO  14 
TE(Gl.LT.C)  GO  TO  15 
KC=1 

CALL  EALSY  (XL.XU.C*FxL».-XU»KC»XN,KT»TfK,KPl,Sl*S2tUl  tUatBP) 
KT  = 1 

7 = G(xu,S1»S2.U1,U2.BB»KT,T*K,KP1) 


65 

66 


67 

QOC 

CR050 

c 


rONTTNUF 

CONTINUE 

NUMTh  = ( UOCLS2  * (NOCL52-1)  )/2 
NT>-  = MOCLS2  - 1 
WRT  TF  (6,ijnS) 

JO  = 0 

no  67  1=1, NTH 

10  = ( 1 » ( 1-1 ) ) /2  ♦ 1 
JO  - Ji"'  ♦ I 

WRT  TF  (6.c;0r  0)  ( TMIJ(J),  J=IO»JO) 

FOOM.-.T  (////  ?X  .•  threshold  array  SYMETTRIC  STORAGE 

FORMAT (//  2X, 10F12.S//4X, lOF 12.5//6X, 10F12.5//) 


6^50 


70 


no  600 

thtji 1) 

CLASS  - 

RFTURN 

ENO 


I =] ,NUMTH 
= THIJ(l)  * ,s 
PAIR  THPESHOLOS 


THR00800 
■TPPOOPIO 
THR00820 
THR00830 
TMH00840 
THR006S0 
THR00860 
THW00870 
THP00880 
THhOOPRO 
THR00900 
THR00910 
THPO092O 
THR00930 
THR00940 
THR00950 
TMR00960 
TMR00970 
THR009B0 
THR00990 
ThROlOOO 
ThROIOIO 
THR01020 
THH01030 
THR01040 
THROIOSO 
THR01060 
THR01070 
THH01080 
THROIOIO 
THPOllOO 
THROll 10 
THROl 120 
THR01130 
THROl 140 
ThROIISO 
THROHGO 
THROl 1 70 
THROl IRO 
THROl 190 
THW01200 


THI 

J('' 

^Th) 

= TAJ  - 

02  - T 

THU01210 

50 

TO 

65 

THW01220 

14 

THI 

J(nTH) 

= TAI  - 

01 

THR01230 

GO 

TO 

65 

THR0124U 

15 

THI 

J (1 

.TH) 

= TAJ  - 

02 

THRO1250 

THP01260 
THR01270 
ThRO.1260 
THRO  1290 
TMR01300 
THROl 310 
THROl 320 
THR01330 
THRO1340 
THR013S0 
THR01360 
THR01370 
THROUeO 
THR01390 
THR01400 
THR01410 
THR01420 
THR01430 
THROl 440 


/ 


12.  DISPLAY  PROCESSOR 


FILE  OSPLAY 


C 

C 

c|‘ 

i 

Cl 

c'i 

Cl 

n 

Cl 

Cl* 

Cl* 


c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c»- 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 


SUBROUTINE  OSPLAY ( ARRAY t TOP) 
IMPLICIT  INTEGER  (A*-HtO-Z) 

DIMENSION  ARRAY m 


CALL.. 

ARGS.. 


CALL  OSPLAY (ARRAYtTOP) 


ARRAY 

TOP 


SFE  ‘MONTOR* 
SFE  'MONTOR* 


PURPOSE.. COORDINftTFS  ROUTINES  FOR  DISPLAYING  CLASSIFICATION 

MAP  and  performance  tables. 


INCLUDE  CMBKIO.LTST 
INCLUDE  COMTIO 

COMMON/OISPL/CATFLG.CATNAM(61) ,CLSNAM(ftl) ,SU8NAM(6l) »SUBN0(60) . 

• SUBCAT  <60) .CLSSUB (60) ,NOMAP,TOTVT3,NOSUB3. 

• PCFnKY.TSTKEY.TRNKEY.THRSKY.STATKY.EMPTRS.THRSVA. 

• PLT>^FY,SKFLG.8MC0MB,BMFFAT.CDATE  (2)  » 

• FLOSV?.FItLn?.VFHTX2,FLOSV3.FlELO3*VERTX3.PCT103f 

• THHFS(60) .SYMMTX ( 66) . HI GH ( 60 ) » CON (60) 

• ,FL'.>KFY,NOFLO?.NOFLD3.NOFET2.FETVC2(30) 

• . NOSUP?. N0TRFD.T0TVT2.N0CLS2 

• .^ATNO{60) .NOCAT, filter. MAPFMT 

• .DESKFY.OESUNI .OFSOTH.CROP  , ACROP, AOTHER. ATOTAL 

• .SITF (6) .ANALYSIS) .CAM (IS) .CRPKEY.KEPPTS(60) 

• .OOTKFY.DOTERR 

COMMON  BLOCK  DISPL  IS  USED  ONLY  IN  THE  DISPLAY  PROCESSOR 


DEFINITIONS 

CATFL6  - 

CATNAM  - 
CLSNAM  - 
SUHNAM  - 
SUBCAT  - 

CLSSU0  - 

NOMAP  - 
TOTVT3  - 
NOSUB3  - 

PCFDKY  - 

TSTKEY  - 
TRNt<£Y  - 

continue 
ThRSKY  - 


M) 


FLAG  INDICATING  WHETHER  OR  NOT  CATEGORY  PERFORMANCE 
REPORTS  MUST  PE  GENERATED. 

Names  of  catfgories.  read  from  maptaP. 

NAMES  OF  CLASSES.  READ  FROM  MAPTAP. 

NAMES  OF  SUBCLASSES.  READ  FROM  MAPTAP. 

SURCL&SS-CATEGORY  CORRESPONDENCE  VECTOR 
(SUHC^T(I)=M  MEANS  SUBCLASS  I BELONGS  TO  CATEGORY 
SUBCLASS-CLASS  CORPESROHOENCE  VECTOR, 

(CLSSUB(I)=M  MFANS  Sl'BCLASS  I BELONGS  TO  CLASS  M) 

TRIGGER  INDICATING  WHETHER  PR  NOT  A MAP  IS  TO  BE  PR1NTEDSP00520 
TOTAL  NP.  OF  VERTICES  IN  INPUT  TEST  FIELDS.  0SP00530 

NO.  OF  SUBCLASSES  USED  IN  CLASSIFY  PLUS  ONE, FOR  THE  DSP00S40 
THRESHOLD  CLASS.  DSP00550 

KFY  IiiniCATING  WHETHER  OR  NOT  GROUND  TRUTH  PERFORMANCE  DSP00560 
REPORTS  are  TO  BE  PRINTED  ON  A PER  FIELD  FASIS,  0SP00570 

KEY  INDICATING  WHETHER  OR  NOT  TEST  FIELDS  WERE  INPUT.  OSPOOS80 
WHETHER  OR  NOT  TRAINING  FIELDS  ARE  TO 


DSPOOOIO 

OSP00020 

DSP00030 

DSP00040 

DSPOOOSO 

OSP00060 

05P00070 

DSP00080 

•lOSPOOORO 

•IDSPOOlOO 

lOSPOOUO 

DSP00120 

lOSPOOlSO 

IDSP00140 

10SP00150 

1DSP00160 

DSP00170 

OSP00180 

IDSP00190 

■IOSP00200 

•IDSP00210 

OSP00220 

OSP00230 

DSP00240 

os.'ooaso 

DSP00260 

OSP00270 

DSP00280 

OSP00290 

DSP00300 

OSP00310 

OSP00320 

OSP00330 

DSP00340 

DSP00350 

OSP00360 

DSP00370 

OSP00380 

OSP00390 

OSP00400 

DSP00410 

OSP00420 

DSP00430 

DSP00440 

DSP00450 

DSP00460 

05P00470 

05P00480 

OSP00490 

OSP00500 

DSPOOSIO 


KEY  INDICATING 
BE  OUTLINED. 


threshold  key 

=1  ABRLY  CHI-SQUARE  THRESHOLDS 
=?  APPLY  EMPIRICAL  THRESHOLDS 
=3  APPLY  USER-INPUT  THRFSHOLDS 
=4  APPLY  FISHER  UlSTHIHOTlON  THRESHOLD 

=0  NO  thresholding 

KFY  FOR  PRINTING  STATS  FROM  MAPTAP 

EMPIRICAL  Thresholding  flag 

USER- INPUT  threshold  VALUE  FLAG 

FLAG  FOR  PRINT  IMG  CUMyilLATIVt  HISTOGRAMS  OF  QUADRATIC 
FORM. 

BMFLG  - FLAG  INDICATING  WHFTHFR  OR  NOT  A P-MATRIX  WAS 
APPLIED  IN  classify. 

NO.  OF  I INFAR  COMRINATIONS  in  H-MATRIX 
NO.  OF  'r^ANNELS  USED  IN  COMPUTING  B-MATPIX 


STATKY 

FMPTRS 

THRSVA 

PLTKFY 


RMCOmB 

HMFEAl 


0SP00S90 

OSP00600 

OSP00610 

OSP00620 

DSP00630 

OSP00640 

OSP00650 

DSP00660 

DSP00670 

OSP006F)0 

OSRn0690 

DSPOOTOO 

DSP00710 

DSP00720 

DSPOOTTO 

DSP007<»0 

DSP007SO 

OSR00760 


FILF  OSPLAY 


C* 

C* 

C* 

C« 

C* 

C* 

C* 

C* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c« 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c» 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c*- 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

C*EN0 

c* 

c* 

c* 

c* 

c* 


COATE  - DATE  OF  CLASSIFICATION 

FLDSVa  - ADDRESS  IN  tARHAV  FOR  TRAINING  FIELD  INFORMATION, 

FOR  EACH  TPAININii  FIF.O  4 PIECES  OF  INFORMATION  ARE 
STORED  - IxFIFLO  NAME 
2»CL«SS  NO. 

3*S.UPCLASS  NO. 

4sN0.  OF  VERTICES 

FIEL02  - ADDRESS  IN  tARPAY*  FOR  RECTANGULAR  AREA  SURROUNDING 

EACH  TRAINING  FIELD.  FOR  EACH  TRAINING  FIELD  5 PIECES 
OF  INFORMATION  APE  STORED. 

1=LINE  START 
2«LINE  END 

CONTINUE 

3XSAMPLE  start 
assample  end 

SxPOINTER  INTO  VERTEX  ARRAY  FOR  VERTICES 
OF  THIS  FIELO. 

VERTX2  - ADRF5S  IN  •ARRAY*  FOR  TRAINING  FIELD  VERTICES. 

FLOSV3  - SAME  AS  FL0SV2  FOR  TEST  FIELDS 

FIELD3  - SAME  AS  FIELD?  FOP  TEST  FIELDS 

VERTX3  - SAME  AS  VERTX?  FOR  TEST  FIELDS 

PCTID3  - ADDRESS  IN* ARRAY*  FOR  PERFORMANCE  TABLE. 

THRES  - threshold  VALUES 

SYMMTX  - SYMBOLS  FOR  EACH  SUBCLASS,  PLUS  THRESHOLD  SYMROL 
AND  OUTLINE  SYMBOLS. 

HIGH  - threshold  REJECTION  PERCENTAGE  - EMPIRICAL  OPTION 

CON  - CONSTANT  FACTOR  FROM  PROBAHILITY  DENSITY  FUNCTION 

FROM  CLASSIFY.  ONE  FOP  EACH  SUBCLASS. 

ELOKEY  - KEY  INDICATING  WHETHER  GROUND  TRUTH  FIELDS  ARE 
ASSOCIATED  WITH  CLASSES  OR  SUBCLASSES. 

NOELD2  - NO.  OF  TRAINING  FIELDS 
NOELD3  - NO.  OF  TEST  FIELDS 

NOEET2  - NO.  OF  CHANNELS  USED  IN  CLASSIFICATION, 


FFTVC2 

NOSUR2 

NOTRFO 

TOTVT2  • 
NOCLS2  • 
KATNO  • 
CONTINUE 

NOCAT  ■ 

filter 


CHANNELS  USED  IN  CLASSIFICATION, 

NO.  Of  SUBCLASSES  USED  IN  CLASSIFICATION, 

NO.  OK  GROUND  TRUTH  FIELDS  FOP  WHICH  PERFORMANCE 
TABLES  WILL  BE  MADE.  EQUALS  N0FLD3  OP  N0FL02. 
TOTAL  NO,  OF  VERTICES  FOR  TRAINING  FIELDS. 

NO.  OF  CLASSES  USED  IN  CLASSIFICATION. 

CLASS  - CATEGORY  CORRESPONDENCE  VECTOR 


(KATN0(I)=M  means  CLASS  1 IS  IN  CATEGORY 
NO.  OF  CATEGORIES. 

FLAG  FOR  SPATIAL  FILTERING  OPTION. 


M) 


MAPFMT  - FORMAT  FOR  OUTPUT  MAP  TAPE 


OESKFY 

DESUNI 

DESOTH 

CROP 

ACPOP 

AOTHFH 

ATOTAL 

SITE 

ANALYS 

CAMS 

CRPKEY 

keppts 


OSP00770 
OSP00780 
OSP00790 
OSPOOBOO 
DSPOOBIO 
DSP00820 
OSPOOB30 
DSP00840 
OSPOOB50 
OSP0OB6O 
DSP00870 
OSP008B0 
OSPOOBRO 
OSP00900 
OSP00910 
OSP00920 
OSROOR30 
OSP00940 
OSP00950 
0SP00960 
0SP00970 
OSP009B0 
OSP00990 
OSPOIOOO 
OSPOlOlO 
DSP01020 
DSP01030 
DSP01040 
DSP01050 
D5P01060 
DSP01070 
DSP01080 
D5P01090 
DSPOl 100 
OSPOlllO 
DSPOl 120 
OSP01130 
OSP0U40 
DSPOl ISO 
DSPOl 160 
DSPOl 170 
DSPOl 180 
DSP01190 
0SP01200 
0SP01210 
INDSP01220 
OSP01230 
OSP01240 
DSP012S0 


KEY  INDICATING  WHETHER  OP  NOT  DESIGNATED  FIELDS  WERE 
NO,  FOR  designated  UNIDENTUHLE  (N0SUU2*5) 

NO.  FOR  designated  OThE»  <n0SUB2*6) 

NAME  OF  CROP  FOP  WHICH  INTENSIVE  TEST  SITE  SUMMARY 
REPORT  IS  TO  BE  PRINTED.  CROP  IS  TO  BE  COMPARED  WITH  OTPSP01260 
ACRES  OF  *CWOP*  - USER  INPUT  DSP01270 

ACRFS  OF  *OTHFR*  - USER  INPUT 
TOTAL  ACRES  IN  CLASSIFIED  SEGMENT 
NAME  OF  SITE  (CLASSIFIED  SEGMENT) 

NAMF  OF  analyst  PERFORMING  STUOY 
NAME  OF  PROCEDURE  CONFIGURATION  USED  IN  STUDY 
KFY  FOR  GENERATING  INTENSIVE  TEST  SITE  SUMMARY  REPORT 
TOTAL,  number  PIXELS  IN  EACH  SUBCLASS 


PSP01280 
P5P01290 
DSP01300 
PSP01310 
RSP01320 
OSP01330 
DSPOl 340 
OSP013S0 
OSP01360 
PSP01370 
DSPOl 380 
D5P01390 
DSP01400 
PSP01410 
DSPOl 420 
DSP01430 
DSP01440 
DSP014S0 
DSP01460 
DSP01470 
nsPoi4fio 

SETUP3  WILL  READ  FIRST  ? RECORDS  FROM  maPTAP,  AND  CALL  RFDIF3  DSPOURO 
TO  READ  IN  CONTROL  CAROS.  ALL  OF  THE  PARAMETERS  IN  COMMON  RLvlCK  DSPOiSOO 
niGPL  ARE  1NITIMI7E  BEFORE- RETURNING  TO  THIS  ROUTINE  IN  AHOITION  DSPOlSlO 
TRAINING  AND/OR  TEST  FIELD  DEFINITIONS  WILL  BE  STORED  IN  'ARRAY*  OSP01520 


HOTKEY  - KEY  INDICATING  WHETHER  OR  NOT  DOT  DATA  CLASSIFICATION 
PERFORMANCE  SUM-tARIES  ARE  TO  BE  PROCESSED:  DOTkEY  = 0 . NO  DOT 

DATA  PROCESSING  ; OOTkFY  .GT.  0 . DOT  PERFORMANCE  SUMMARIES 
ARE  PROVIDED  (CHANGED  TO  INDICATE  LIST  PROCESSING 
INSTEAD  OF  DOT  PROCESSING  ON  MAY  1979) 

DOTERR  USE  OF  THIS  FLAG  REMOVED  MAY  1979 

FLAG  NOT  needed  WHEN  lIST  SUBSTITUTED  FOR  DOT  PROCESSING 
CONTINUE 


FILE  OSPLAY 


(!•••  THIS  ADDED  OR  CHANGED  NOV, 13t 1978  TO  INCLUDE  LIST  PROS. 

C 

DIMENSION  DES5AV(4,50) tOESFLD (5*50) *UCSVER(1100) 

REAL  ALP<2) 

STOPsO 

CALL  SETUP3(ARRAY.T0P.riTUNIT,6TFILE»AlUNlT.AlFlLE*  . ^ 

* PPUNlT,PPFILE.NAMtCT.ALP*OESSAV*OESFLDiOESVER*NOFL04«STOP) 
IF(ST0P.FQ.0)60  TO  5 
WRITE (6*6100) 

6100  format (//*1X* »NO  MAP  AVAILABLE  FROM  CLASSIFICATION  PROCESSOR.*) 
GO  TO  999 

C* 

C*  OSPLYl  WILL  READ  NEXT  2 RECORDS  FROM  MAPTAP  AND  PRINT  THE 
C*  STATISTICS  IF  REQUESTED. 

C» 

5 CALL  OSPLYl 

C*H**  CODE  ADDED  NOV.  13*1978  TO  INCLUDE  LIST  PROCESSING 

C**«*  CODE  changed  may  1979  TO  SUBSTITUTE  LIST  FOR  DOTS 

C _ 


C*  OSPLYl  WILL  READ  NEXT  2 RECORDS  FROM  MAPTAP  AND  PRINT  THE 
C*  STATISTICS  IF  REQUESTED. 

C» 

5 CALL  OSPLYl 

C*H**  CODE  ADDED  NOV.  13*1978  TO  INCLUDE  LIST  PROCESSING 

C**«*  CODE  CHANGED  MAY  1979  TO  SUBSTITUTE  LIST  FOR  DOTS 

C 

IF  (nOTKEY.NE.O)  60  TO  30 
IF(EMPTRS.NE.2.AN0,  PLTKEY .NE. 1 ) 60  TO  30 
C* 

C*  FMTHRS  COMPUTES  AND  PLOTS  THE  HISTOGRAM  OF  THE  QUADRATIC  FORM 

C*  FOR  THE  CORRECTLY  CLASSIFIED  PIXELS  WITHIN  THE  TRAINING  OR  TEST 

C«*  FIELDS. 

C* 

IF(FLOKEY.EQ,1)GO  TO  10 
WRITE(6*100) 

GO  TO  30 
10  CONTINUE 

IF(TST^EY.EQ.1)CALL  EMTHRS ( ARRAY (FLDSV3) . ARRAY (FIEL03) * 

* ARRAY (VERTX3) .N0FLD3) 
IFITSTKEY.NE.DCALL  EMTHRS(ARR4Y  (FLOSV?)  .ARRAY  (FIEL02)  * 

* ARRAY (VEHTX2) *NOFl02) 

30  CONTINUE 

C- 

C-  TEST  THRSXY  = 4 FOR  FISHER  F-DISTRIPUTION  THRESHOLDS 

C-  CALL  FOIST  TO  COMPUTE  AND  STORE  THRESHOLDS 

C- 

IF (THRSKY.EQ.A)  CALL  FOIST 

C- 

C*  0SPLY2  PRINTS  THE  MAP  AND  CALLS  PCT  TO  BUILD  PERFORMANCE  TABLES 

C* 

CALL  DSPLY? (ARRAY (FLOSV?) * ARRAY (FIFLD2) .ARRAY (VERTX2) * 

* ARRAY (FLDSV3) .ARRAY (FIELDS) * ARRAY ( VERT X3) * 

* ARRAY (PCT 1D3) . GT UN  I T . GTE ILE * 

* AIUNIT , A1FILE.PPUNIT.PPFILE.NAMECT.ALP* 

* DESSAV  .otSFLO.OFSVEH.NOFLD*.) 

C*  IF  DOT  DATA  PROCESSING  WAS  REOUFSTEO*  THE  PERFORMANCE 
C*  TABLES  WERE  PERFORMED  IN  0SPLY2 

C* 

r 

C*»*  CODE  ADDED  NOV  13.1978  TO  INCLUDE  LIST  PROCESSING 

C***  CODE  CHANGED  may  1979  TO  SUBSTITUTE  LIST  FOR  DOT  PROCESSING 

^ IF  (OOTKEY.GT.O)  GO  TO  99 

C* 

C*  PRTPCT  PRINTS  the  PERFORMANCE  TABLES 

C* 

IF(TSTKEY.NE.1'C..LL  PRTPCT(  array  (FLOSV?)  . ARRAY  (PCT  103)  .NOFLD?) 
99  IF  (TSTKEY.^'U.  1 ) CALL  PRTPCT  (ARRAY  (FLDSV3)  . ARRAY  (PCT  103)  .NUFLD3) 
WRI TF (6.6000) 

6onn  format ( iHiix. ' •••*«  display  completed  •***»•///) 

100  format (/•  **niSRLAY«»  - FIELDS  MUST  BE  DEFINED  FOR  SUBCLASSES 

* EMPIRICAL  THRESHOLUS*/) 

999  return 

END 


DSP01530 
0SP0i540 
DSP01550 
OSP01560 
DSP01570 
DSP01580 
DSP01590 
DSP01600 
OSP01610 
DSP01620 
OSP01630 
OSP01640 
DSP0|650 
OSP01660 
DSP01670 
DSP0I680 
OSPO1690 
DSP01700 
OSP01710 
OSP01720 
DSP01730 
OSP01740 
OSP01750 
OSP0i760 
OSP01770 
DSP01780 
OSP01790 
DSP01800 
DSP01810 
DSP01820 
OSP01830 
OSP01840 
OSP01850 
DSP01860 
DSP01870 
OSP01880 
PSP01890 
DSP01900 
OSP01910 
DSP01920 
OSP01930 
OSP01940 
DSP01950 
DSP01960 
OSP01970 
. 05P01980 

OSP01990 
DSP02000 
OSP02010 
DSP02020 
DSP02030 
D5P02040 
nSP020SO 
nSP02060 
DSP02070 
OSP02080 
D5P02090 
DSP02100 
OSP021 10 
DSP02120 
OSP02130 
DSP02140 
OSP02150 
DSP02160 
DSP02170 
OSP02180 
OSP02190 
OSP02200 
F0ROSP0?210 
OSP02220 
nSP0??30 
OSP02240 


f f 


oor»  ooo  or>o  ooo  noo 


FILE!  CHI 


RE4L  function  chi (X,N,IFL#G) 

TO  COMPUTE  THE  VALUE  OF  THE  ChT-SOUAREO  BIsTR IBUtTon'wTth'n-oTf" 


IF(X.GT.O.O)  GO  TO  5 

CHl=n.O 

RETURN 


degrees  of  FREEDOM  IS  EVEN 

5 IF«M00!N.2) .EO.O)  GO  TO  1 

CALCULATION  OF  CH?  FOR  1 DEGREE'oF'FREiDOM 


GsSORT  (X) 

CHl=2.0*RN0OM(G)-1.0 
G=G/1.?S331A1A 
IN=3 
GO  TO  ? 


CALCULATION  OF  CHI  FOR  2 DEGREES  OF  FREEDOM 


1 IN*4 
Ksx/p.n 

IF(APS(G) .GT.8P.027)  GOTO  4 
rHI=l.n-EXP(-G) 

2 IF(N.LT.3)  return 
IF(A9S(x/2.0) .GT.88.027)  GOTO  4 
6sG*EXR<-X/2.0) 


CALCULATION  OF  CHI  FOR  N-GT-2  DEGREES  OF  FREEDOM 

DO  3 i=IN»NTi 

CHI=CHI-G 

G=G*X/I 

CALL  OVERFL(INOCT) 

IFdNOCT.EQ.DGOTO  4 

3 CONTINUE 
RETURN 

4 IFLAGsl 

return 

END 


CHIOOOIO 

-CHI00020 

CHI00030 

-CHI00040 

CHIOOOSO 

CHI00060 

CHI00070 

-CHIOOOfiO 

CHI00090 

-CHIOOIOO 

CMIOOIIO 

-CHI00120 

Chioono 

-CHI00140 

CHIOOISO 

CHI00160 

CHI00170 

CHIOOIRO 

CHI00190 

-CMI00200 

CHI00210 

•CHI00220 

CHI00230 

CH100240 

CHI00250 

CHI00260 

CHI00270 

CHI00280 

CHI00290 

■CMI00300 

CHI0O31O 

-CHin0320 

CHI00330 

CHI00340 

CHI003SO 

CHI00340 

CHI00370 

CHI00380 

CHI00390 

CHI00400 

CHI00410 

CHI00420 


pilf:  chin 


FUNCTION  CMlNULPHAtN.IFLAG) 
OIMFNSIOn  h(7).  0(15> 

EOniVALENCE  (H(7),  0«1S>» 
data  n/“. 7OB0. 4020. 0600* 
1 . 0120. -.01  no*-. 0360.-. 0300.. 0 120t. 1 
IFLAGaO 

IF(N.EQ.l)  CHIN»(TINORM( (1.-ALPHA/2 
IFHFLAG.FQ.l)  GOTO  lO 
CHIN»CHIN**2 

IF(N.F0.2)  CHIN  = -2,  • ALOG(ALPHA) 
IF(N.LE.2»  PFTUPN 
XsTlNOPMd  .-ALPHA,  IFLA6) 
IF(IFLAG.EU.l)  GOTO  10 
1=2. *X 

IF(I.LT.-T»  I=-7 
IF(1.6T.6>  T=6 

Y=(H(1) ♦<2.*X-I) *(H(I*1)-H(I)  ) )/N 

XsN* ( 1 .-CHIN. (X-Y) ♦SORT (CHIN) »**3 
TF( (N.IE.SS.ANO.X.LT.O.)  ) 

if(n.lf.s?)  go  to  1 

IF(X.6T.176.16)  GOTO  10 
CHIN=X 
A RETURN 

1 TC»0 
IE=N-2 
IB=3 

Gs2.G0G6283 

IF(H0n(N.2) .EO.l)  GO  TO  2 

IRs2 

Gs?. 

2 TFdF.Lf.DGO  TO  11 

no  3 I=1H.1E.2 

3 GsR*l 

11  N2  = (N-2)/2 
N3  = N-2-N2 
SOX  = S'iRT(X) 

CHA  = ( d.-CHl (X,N,IFLAG)-ALPHA)*G)/ 
IFdFLAG.FO.l)  GOTO  10 
CHG  = FXP(X/?.)/(SQX**N3) 

CHIN  = X ♦ CHA*CHR 

IF(APS(X-CHIN)/AHAX1 (X.CHIN) .LT.5.E- 

IFdC.GT.?00>  RETURN 

IC=IC»1 

X=CH1N 

lF(X.GT,176.1ft)  GOTO  10 
GO  TO  11 
10  IFLAG=l 

return 

ENn 


^^IG[\AT  Da 


.0060*. 0360*. 0360* 
020*. 2560*. 4920/ 

.) .IFLAG) ) 


CHlOOOlO 
CHI00020 
CH100030 
CH100040 
CHI00050 
CHI00060 
CH100070 
CHiooono 
CHI00090 
CHlOOlOO 
CHIOOllO 
CHI00120 
CH100130 
CHI00140 
CH100150 
CHl 00160 
CHI00170 
CHIOOIHO 
CHI00190 

X=N* d.-CHlN.X«SQRT (CHIN) )**3CH1 00200 

CHI00210 
CH100220 
CHI00230 
. CHI00240 

CHI002SO 
CHI00260 
CHI00270 
CHIO02H0 
CHI00290 
CHI00300 
CHI00310 
CHI00320 
CHI00330 
CHI00340 
CHI00350 
CH100360 
CHI00370 
CHI00360 
CHI00390 
CHI00400 
CH100410 
CHI00420 
CHI00430 
CHI00440 
CHI004S0 
CHI00460 
CHI00470 
CHI004RO 
CHI00490 
CH100500 


(SOX**N2) 


06)  GO  TO  4 


FiLEt  nesiG 


c* 

c* 

c* 


c* 

c« 

c* 


SUBROUTINE  OESIG(LlNE.IR»FLOSAVtFIELO  » VERTEX, NOFLOt 
• SAMSTH,SAMEND,SAM1NC) 

IMPLICIT  INTEfiFR( A-Z) 

DIMENSION  IM<1) ,FIEL0(5,N0FL0) , FLDSAV ( A ,NOFLD) » VERTEX < 1 ) ,FL ( 22) 
THIS  ROUTINE  SETS  THE  IR  ARRAY  FOR  DESIGNATED  FIELDS 
DO  50  Tsl.NOFLD 

IF(LlNF  .LT.FIFLO(l.I) )G0  TO  50 
IF(LINF  .6T.FIELU(2»I) )G0  TO  50 
IF(FIEL0(3»I) .GT.SAMEND)G0  TO  50 
IF(FIEL0(4,I) .LT.SAMSTR)GO  TO  50 

FOUND  A DESIGNATED  FIELD  ON  THIS  LINE 

NV=FI.D5AV  <4,  I) 

IPT=FIEL0(5,I) 

ID  = FLDS4V(2.I) 

CALL  FOLINT(VERTEXnPT)  ,NV,FL  ,L  INE,SAMPS,NI  ) 
no  20  .J=1.NI.2 
IB  = (<^L(J)-SAMST»)/SAMINC*1 
IE  = (FL(J,1)-S4«STR)/SAMINC*1 

TF(MnD(SAMSTR,SAHINC)  .NE.  MOO (FL ( J) ,SAMINC) ) IB=I8*1 
if(Ir.gt.if)Go  to  20 

DO  10  K=IB,IE  . , 

10  IR(K)=IO 
?0  CONTINUE 
50  CONTINUE 
return 
END 


or»r>  onr>  ooo  o o ooooonoo 


FILF*  DISTCW 


SEND 


13 

un 

10 


?o 


SU1R0UT1NF.  niSTCV  (DSFUNCtTOTPTS. RANGE) 
IMPLICIT  INTFGFR(A-Z) 


OlSTCV  PLOTS  THE  DISTRIBUTION  AND  CHl  SOUARF  CURVES  AND  COMPUTES 
THE  EMPIWICAL  THRESHOLD  VALUES 


REAL  0.  DSFUNC.DISTVL, THRESH. REJ£CT»PCTREJ.THRES»CM1S01 
REAL  RFJPCT.CHISf). INC. CHIN 

DIMENSION  DSFLINC (OANGE.feO) . TOTPTS(l).  THRESh(^O),  MINM(60). 

* SYHBLSnOO).  FIEL0S(2)  .FIELDl  (?)  . PCTREJ(60) 

DIMENSION  CHISO(IOO) 

INCLUDE  CMRKin.LIST 

COMMON/DISPL/CATELG.CATNAMOS)  ) .CLSNAM(61)  .SUB^;AM(61)  .SUBNO(60)  * 

* SUHCAT  CSO) .CLSSUB(60) .NOMaP. TOTVT 3.N0SUB3. 

* PCFDKY.T';TnEY.TRNKEY.TH«SKY.STATKY.EMPTRS.TMRSVA» 

* PLTKFY,BMFLG,PMCuMH»eMFFAT»CUATE(?) . 

* Fl.DSv?,FIELO?.VEPTX.i.FLnSv3.FIELD3.VERTX3.PCT103. 

* THPFS (60) .SYMkTX (66) .high (60) .CON (60) 

* .FLDKEY.N0FLD2.N0FL03.N0FET2.FET VC? (30) 

* .NOSUB2.NOTHFD.TOTVT2.NOCLS2 

* .KATN0(60)  .NOCAT. FILTER. MAPFMT  „ , , , 

* .DESKEY.OESUNI .OESOTH.CROP  .ACROP. AOThER.ATOTAL 

* .SITE (6) .ANALYSIS) .CAM( IS) .CRPKEY.KEPPTS (60) 

* .OOTKEY.DOTERR 

DATA  FIELD  /'TEST*/.  FIELDS/'TRAI  • . »NIN(?»/ 

DATA  BLANK/'  » / . MXOU AO/20/ 
data  ASTK  /""/.dollar  /'S'/ 

FQIIIVALENCE  ( HIGH(l)  .PCTREJ(l)  ) _ 

DO  S 1=) .2 
FIFLUl (I)  = BLANK 
DO  To  L=1.9P 

RFJPCT  = 1.  - FLOAT(L)  / 100.0 
CHISOl  a CHIN(REJPCT.NOFET2.FLaG) 

IF(FLAG.EQ.l)  GOTO  13 
CHISO(L)  a CHlSOl  ♦ 0.05 

GO  TO  10 

WR1TE(6,160)  RE.JPCT.ChISQI 

format ( • OVERFLOW .2X.FS.2.3X.F15.5) 

CONTINUE 

CALL  SFTMRG(66,0.66) 

DO  ?no  Jal.MOSUB2 
T0TPTS(J)=0 

no  20  Msi. range 

TOTPTS(J)  = OSFUNC(M.J)  ♦ TOTPTS(J) 

CONTINUE 

IF  (TOTPTS(.J)  .FQ.  0)  GO  TO  200 
40  M= 1 . RANGE 

= M - 1 

0)  06FUNC (nN.I, J)  = (DSFUNC (MM*1 . J) 

0)  GO  TO  40 

= OSEUNC(MM.J)  ♦ (OSFUNC (M, J)  / TOTPTS(J)) 


no 

MM 

IF 

IF 


/ TOTPTS(J))  * 


(MM  ,ED. 

(MM  .EO. 

OSFUNC (H.J) 

40  CONTINUE 

FIND  MINIMUM  M for  WHICH  DSFUNC(M.J)  .GT.  1 - 100*PCTREJ 

niFTVL  =(1.  - PCTREJ(J))"  100 
MXMEJT  = DISTVL  ♦ 0.5 
no  SO  M=l. RANGE 

IF  (niFTVL  .LF.  DSFUNC(M.J)  ) MINM(J)  a M 
IF  (DISTVL  .LE.  05FUNC(M,J))  60  TO  55 
SO  CONTINUE 
5S  CONTINUE 


100 


THRESHOLD 

REJFCT  = PCTWEJ(J)  * 100 
IF  (TSTKEY  .FO.  1)  FlELOKl)  a 

IF  (TSTkEY  .E'J.  0)  FlELOlO)  = 

IF  (TSTKEY  .ED.  0)  FIELD] (2)  a 

TH»fSH(J)  a(0.1  • MINM(J))  * 2 

PRINT  HEADING 

CLASNOaJ 


field 

FIELDS!  1) 
F IELDS(2) 


DISOOOlO 

OIS00020 

CI01S00030 

OIS00040 

DIS00050 

01S00060 

DIS00070 

D1S00080 

DIS00090 

CIDISOOIOO 

Disoono 

OIS00120 

OIS00130 

DIS00140 

DIS00150 

DIS00160 

DIS00170 

01500180 

DIS00190 

OIS00200 

DIS00210 

OIS00220 

DIS00230 

D1S00240 

QIS00250 

0IS00260 

OIS00270 

OIS00280 

DIS00290 

OIS00300 

01S00310 

01S00320 

DIS00330 

OIS00340 

D1S00350 

01S00360 

01500370 

D1S003F0 

OIS00390 

OIS00400 

UIS00410 

DIS00420 

OIS00430 

01S00440 

DIS00450 

DIS00460 

OIS0047C 

DI500480 

DIS00490 

OlSOObOO 

DI500510 

DIS00520 

P1S00530 

100OIS00S40 

OIS00550 

OIS00560 

01500570 

DIS00580 

D1S00590 

nisnoeno 
nisoo6io 
DIS00620 
DIS00630 
01S00640 
DlSnObSO 
D1S00660 
D1S00670 
DIS00680 
D1S006R0 
U1S00700 
OISf'0710 
Disno  720 
DIS00730 
D1S00740 
O15007S0 
DIS00760 
D1S00770 
ni 500780 
UIS00790 


i^Cf 


ooo  r>oo 


i 


FILE:  OISTCV 


WRITE  <«S,1 00)  SUBWftM(J) 
100  FORMAT  (IHl  ♦////!•;?.  *0 


. - _ . 1 ♦////!•)?. 'OISTRIBTION  curve  for  subclass  '*A4. 

WRTTE(6*105)  ThRES(CLASNO) .REJECT. (FlELOl (I) .1=1.?) .THRESH<J) 
lOB  format  ( ///  TIO.  «CHI  square  THRESHOLD  = '.F5.?.  T53.  'EMRIRKAL 
•HRESHOLO  FHOmi,  T91.  'USER  REJECTION  PERCENTAGE  « F4.1/  T53. 

* ?A4.  • FIELDS  » *.F5.2) 

WRTTF(<S.110) 

no  F0RMAT<///T15t  lOdHO.RX)  «1H1./  TIS.  * 0 * . <>X . • 1 • , 9X,  • ?•  .9X  . • 3*  .9X  . 

* •4*.9X« •S'.RX* 'G'.SX.'T'.QXt  *B**9X« '9*  *9X. *0*/ 

* T15.il (1H0.9X)/ 

* T11.I0,0*.1X.10H1H*)) 

INC  « FLOAT (MXOUAO)/  FLOAT (RANGE) 

II  = 1 
N s 0 

00  90  L=l. range 

0 8 FLOAT (MXOUAO*L)  / RANGE 

N 8 N ♦ 1 

no  60  M=  1.100 

60  SYMBLS(M)  s BLANK 


01S00800 
.A4)  OIS00810 

THHESH<J)  DIS00820 

EMRIRICAL  TD1S00830 
,1/  T53.  01S00840 


RANGE 


CHI  SQUARE  CURVE 

65  IF  ( II  .GT.  MXPFJT  ) GO  TO  75 

IF  ( CHISO(II)  .GE.  (Q*INC)  ) GO  TO  75 
SYHBLS(Il)  = ASTK 
II  » II  ♦ 1 
GO  Tn  65 

75  CONTINUE 

DISTRIBUTION  CURVE 

PERCM  = OSFUNCtL.J) 

IF  (PFRCNT  .EO.  0)  GO  TO  77 
IF  (SYMaLS(PF.RCNT)  .NF.  BLANK)  SYM 
IF  (SYMBLS(PEECNT)  .NE.  BLANK)  60 

76  SYMRsj 

SYMHLS (PERCNT)  = SYMMTX(SYMB) 

77  CONTINUE 

IF  (N  ,eQ.  5)  GO  TO  BO 
WRITE (6.1201  (SYMELS(K) .K= 1,100) 

120  FOOMAT(T15.'*'.100A1) 

60  TQ  QO 

BO  WPITE(6.no)  0.  (SYM«LS(K)  .K=l,100) 
no  format (T10.F4.1 .IX. t lOOAl) 

N s 0 

90  CONTINUE 

wRTTF(6,no)  SYMMTX(SYMB) 


SYMBLS (PERCNT)  = DOLLAR 
GO  TO  77 


FORMAT (///TIO.  ‘NOTE 


CLASS  DISTRIBUTION  CU»VE*//T1B. 


OIS00B40 

DIS00850 

O1S00B60 

DIS00870 

DiSOOBBO 

D|S00890 

DIS00900 

DI500910 

DIS00920 

DIS00930 

01500940 

OIS00950 

D1S00960 

UIS00970 

OIS009B0 

OIS00990 

nisoiooo 

OlSOlOlO 

D1SOI020 

OIS01030 

DIS01040 

DISOIOSO 

01501060 

01501070 

oisoioeo 

DIS01090 
UISOllOO 
OlSOlllO 
OlSOl 120 
DIS01130 
01S01140 
OIS01150 
01S01160 
01501170 
OiSOllBO 
UIS0U90 
OIS01200 
D1S0I210 
OIS01220 
D1S01230 
OIS01240 
DISOlPSO 
OIS01260 
OIS01270 


- CHI  S(5UAR£  distribution  CURVE'//T1B,  »S  - INTERSECTION  OF  CURVOIS012H0 
•FS»)  OIS01290 

IF  (EMPTRS  .FO.  0)  GO  TO  200  01S01300 

TH«FS(J)=ThRESH(J)  OIS01310 

?00  CONTINUF  DIS01320 

CALL  SETMRG(66.4.62)  OIS01330 

return  01501340 

END  DIS01350 


oooooo  oooooooooo 


FILE!  OSPLYl 


ORK’.INAL  PAGE  It" 
OF  POOR  QUAUTV 


SUBROUTINE  OSPLYl 
IMPLICIT  INTEGER  (A-H*0»2) 


Include  com«k6*list 

REAL  CON,nET(60f 
include  CmmkIO.I  1ST 

C0MM0N/GLPiJAL/HEA0<63> .MAPTAP.D4TAPEtSAVT4P»BMFlLt*8HKEY» 

HIsriLfHISKFY.TRFORM,EHIPTP*ERPKEYtMAPUNTtNOFlLEf 
D»UMArt|Of?MwnStPAGSI/*UATFlLtSTAFlL«ASAVtASAVFL 
»NHSTIIN.NHSTFI tSCTPUN»MAPFIL 

» OOTUNT . nOTF 1 L . NCHP  A S t TRNSFL  » BMTRFL ♦ M I STFL  » PCHUNT  t 
CPDUMT.PRTUNT.RANDIO 

COMMON/DISPL/CATFi  ft.CATNAM(M ) ,CLSNAM(6U  tSUeNAMjei ) tSUBNOIGO) ♦ 
SIJPCAT(^O)  .CLSSUH(60)  . NOMAP. T0TVT3.N0SU83# 
PCrDKY,TSTHEV.TRNnE> .THPSKY.STATKY.EMPTRS.TMRSVA. 
PLT«EY,8MFLG.nMC()Mrt.pMFEAT.C0ATE(2)  • 
FLnSV2,FIEl.n2.VFMTX?.FL5sV3.FIELD3.VERTX3.PCTlD3» 
THPES<60) .SYMMTX (66) .HIGHChO) .CON <60 ) 
,FLOKFY,h0Fin?,NOFLO3.N0FET2.FElVC2<30» 
.NnSUH?.NOTRfD.TOTVT2.NOCLS2 
.KATNO(60) .NOCAT. FILTER. MAPFMT 
.OESKEY.OESUNI .OESOTH.CROP  .ACROP.AOTHER.ATOTAL 
.SITK(6) .ANALYSIS) .CAM(IS) .CRPKEY.KEPPISI60) 
.OOTKEY.DOTERR 

DIMENSION  STORAG (95001 
DATA  SI7E/95nn/ 

DATA  RCOFOR/'A*/.  BC0Tto0/'2‘/.  DASH/*— — •/ 


CSENO 


RETRIEVE  ANO  PRINT  THE  COVARIANCE  AND  MEAN 


200  1F(  BMFLG  .LE.  0)  GO  TO  202 

C 

NOFET?  » 8MC0M8 
202  CV»1 

VARSZ2SUOFET2* (N0FET2*! ) /2 
MWsCV  ♦ VApt;7P*NOsi)R2 

IF(MN  ♦ NnsuP2*NOFET^  .GT.  SIZE) GO  TO  180 
(VO  TO  IPO 
170  CONTINUE 

C*  CALL  DSPLTA(STORAGE(CV) .STORAGE(mN) .VARSI22.NOFET2.NOSUB2) 
PFTUPN 

190  WOlTf(G.lA!) 

181  FOPMAT(*  not  ENOUGH  STORAGE  FOR  COVARIANCE  MATRICES  - OSPLYl') 
CALL  CMERP 
CONTINUE 
RETURN 

END  — SiioPOUTINE 


OSPLYl 


INTERNAL  SUBROUTINE  USPLIA 

• SUBROUTINE  OSPLl A (COVMTX.AVEMTTX.vAK522.NCrET2»NOClS2) 

• COVMTX(i.l)sSTOBA6E(l) 

• AVFmtx(  1 .U)  xSTORAGf  1MN-1»I*  (J-n*NOF£T2 

190  CONTINUE 

READ  ORIGINAL  COVARIANCE  AND  MEANS  MATRIX  FOR  EACH  CLASS 

( h-transformfd  if  h-matrix  ras  applied  in  SCLASSIFY  - 

BMFLG  ,GT,  0 IF  SO  ) 


PSP00030 

DSPO0OX»O 

OSPOOOSO 

OSP00060 

DSP00070 

DSP00060 

OSP00090 

lOSPOOlOO 

mwi 

OSPOOIAO 
SPC 
SP{ 

SP( 

DSPOO] 
OSPOOj 

ospooi 

81^881 
OSPOOj 
OSPOOt^  . 
OSPOOOSO 
OSP00260 
QSP00270 
PSP00280 
OSP00290 
DSP00300 
OSP00310 
OSP00320 
OSP00330 
DSP003^0 
DSP00350 
DSP00360 
OSP00370 
DSP003UO 
OSP00390 
OSP00400 

nspoo^lc 

•OSP00420 

OSP00430 

DSP00440 

-OSP00450 

OSP00460 

OSP00470 

OSP004B0 

DSPOOS90 

DSP00500 

USPOOSiO 

OSP00520 

O5P00S30 

OSP00540 

0SO00550 

OSPO0560 

DSP00570 

OSP005B0 

nSP00590 

OSP00600 

OSP00610 

OSP00620 

OSP00630 

OSP00640 

•OSP00650 

OSP00660 

OSP00670 

DSP00680 

OSR00490 

nSRC0700 

OSB0r,710 

OSPO0720 

OS»00730 

L)SP00740 

OSP00750 

DS'->00760 

OSP00770 

DSP00780 

OSP00790 


oonr>rw"> 


FILE!  OSPLYl  , 


C 

C 


NS  ■ VANSYg  • NOCLS? 

NSS  ■ N0FFT2  • NQCLS2 
READ(H«PTAPT (ST0ftA6(CV*l-l ) * I«1 « 

IF  (STATKV.EO.O)  60  TO  290 


NS)«IST0RA6(MN*I-1) tlal.NSS) 


■ J#^0FCT2) • ( (N0FET2* I 1 ) /12) 


Phi. 

CNT 


??Sr:£v,‘s«!’'as^« 

[TE  (AtHEAD) 


210 


210  WRlTE(A*2?0)  SUBNAM(ICLAS) ♦SrMMTX«ICLAS)» (Dash  tl»lt5) 
220  format (//•  SUBCLASS' fA«t*  REPRESENTEO  BY  SYMBOL  - 
• 1X»3A4,A1 .TAAtAJ/) 

on  230  L0C«l.N0FET2f 12 
STOP  ■ ror*!! 

IF<  STOr>  ,GT,  - 

NS>MN- 1 ♦ ( I cl AS-1 > •NOFETf 
WRITE (A*?AO) (ST0RA6(NS*l)*I*L0CtST0P> 

230  CONTINUE 

2A0  FORMAT  CO  MEAN!  • t3X*12F9.2) 

WRITEiA»2A01)  DASH 
2601  FORMAT ( IX tAA/) 


••Al  / 


NOFET2,^^STOP  ■ NOFET2 


IF(  RMFL6  .GT.  0)  60  TO  271 

WR1TF<6.270)  (OASMtl»l*S> 

GO  TO  272 

FORMAT  COrOVAR  I ANCE  MATRiXC 


WRITE (6,?7fl)  ( DASH,  l»|t9) 

_ format  ( »f»COVARIANCE  MATRIX 
272  NS«I* (ICLAS-1)*VARSZ2 


/ lX.SAA) 
(B>TRANSFORMEOt 


t'/lX»8AA*A3) 


^A^L^W«TMTX(STORAG«NS) ♦N0FET2»BC0TW0) 


INC*l 
280  CONTINUE 


Pf AO  COVARIANCE. MATRp 

matrixOeterminant.  get  ♦ for  each  class 


PROBABILITY  DENSITY  FUNCT 


( after  CHQLESKY  FACTORIZATION) ♦ 

ION  CONSTANTSt  CON  * AND  COVARIANCE 


•|*1»N0CLS?) 


NS  « l*(I-l)*VAPSZ2 

CALL  WRTMTX(STORAG(NS) «NQFET2tBC0F0R) 

INC  * INC*1 
310  CONTINUE 

320  FORMAT (//IX. 'muLTSPECTRAL  rHAHACTERISTlCS  FOR  SUBCLASS  'fA*.' 
IRFPRESENTFO  BY  SYMBOL  • .Al/lHO. 'DETERMINANT  ■ • tF 18. tf/lHO . 'CON 
■ F10.4//1M0* 'COVARIANCE  MATRIX  (CHQLESKY  OECOMROSIT 


|pio920 
5P00930 
1P0094C 
|P009SC 
SP00962 
5P0097( 


)f 


290  CONTINUE 

NS  » VAPS72  • NnCLS2 

READ (M APT AP) (ST0RAG(CV*I-1) »I»l.NS) . ICON  1 1 ) t I-l tN0CLS2) . (OET ( I 
* ‘ NOCLS?) 

STATKY.EQ.O)  go  TO  330  • 

CNT  ■ n*(3*?*N0FET2)*((N0FET2*ll)/l2) 

CnT  ■ PAGSIZ/CNT 
luC  * CNT 
00  310  1»1»N0CLS2 
IF  (InC.LT.CNTT  go  to  300  . 

WPITE  I6*H£AD) 

INC  >0 

300  WRITE  (4,320)  SIIBNAM  ( I ) , SYMMTX  ( I ) .OET  1 1 ) tCON 1 1 ) 


i 


T TEPM 
I'  ) 

GO  HOHF 


SPO 
5P0 
PO 
PO 
PO 

nspo 

OSPO 
PSPO 
6sP0 
OSPO 
OSPO 
QSPO 
OSPO 
OSPO 
OSPO 
OSPO 
DBPO 

pr>o 

OSPO 
pSRO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
OSPO 
QSPO 
OSPO 
QSPO 
OSPO 
OSPO 
OSPO 
QSPO 
OSPO 
OSPO 
OSPO 
OSPO 

stanospo 

I0N)0S»0 
OSPO 


330  CONTINUE 

NOCLS2»OUMMY 
GO  TO  170 
END 


OSP01480 
OSP0|490 
-OSPO  “ 
OSPO 
QSPO 
nSPO 
OSPO 
OSPO 


riLC  osptti 


ORIOTNAL  PAGE  IS 
Of-  Ponn  QUAun 


H«.TSTSAV«TSTrLO* 
tSVCRtNOrLOA) 

CODE  ADDED  NOV  13fl978  TO  INCLUDE  LIST  HROCESSlNO 

real  alp (2) 


OSP.j|2^CAN 


PERFORM  spatial  FlLTERlNli  ON  THE  CLASSIFIED 
THE  FOUR  NEAREST  NEIGHBORS  OF  EACH  PUEL  ARE 
TESTED  FOR  •SAMENESS'*  IF  THE  FOUR  NEIGHBORS 
CLAsIiFIEO.AS.OnE  TYPC.ANO.THE  pYxEL_In  OUE5 

TVPEf 


CL  AS 
WAS 

IS  CM  _ 
EXAMPLE! 

LINE  N 

N*1  - 
N*i  - 

OSPLYZ  ALSO  PERFORMS  TMH 
MAP.  anq.^A|j^s_tmE  appro 


. ^ YP 

lassified  as  a U 

lANGED  TO  THE  SAMI 


cSc 

C 


DATA* 

ARE 


ENT  TVPtf^THE  CLAfii??CAT10N 
THE  NEIGHBORS.} 


- X IS  CHANGED  TO  C 


THE  CLASS  1 


Sation  performance 


ormance  tables. 


list  processing  added  NOV  13.  1978  OOTSEY 
NAME  OF  THf  - - - — 


SWITCH' (CHANGED  FROM  LISTSW'MAY^iJtI} 


.TSTSAV  (<*.NOFL03)  .T 
.COLl3.no)  .SCRAT(330)  .fli 
,IR(  - - “ 


;TFL0(S.N0FL03) .tstvercz.totvI 
)INF(6) 


^ I 


CSENO 


.NOSUH2,NOTWrD.TOTVT2.NOCL52 
.KATNO(fcn) . NOCAT. F ilter.mapfmt 
. DE  <SKF  Y . OE SUN  I . DE  SOTH . CROP  . ACRQP  . AOTHER  . ATOT  AL 
.SITT (6) .PNALYS(S) .CAM < IS) .CHPKEY.KEPPTS(60) 
.00T‘ EY.OOTERR 


logical  start. full 

DATA  AST/**»**»/ 

DATA  TMRtSH/'THRE'/. blank/' 
EQUIVALENCE  (FlOINFII), 

I (ELplNF (3) .lInINC) . 

i (FLOInF (S) .SAMEND) . 

3 (COL.SCRAT) . (IR.0UF) 


•/ 

INSTR) . 


).LINE 

INFIM).  SAm! 


'FLDINFC 
(FLOINFC.)  . _ 
(FlDINF(6) .SAMIN 


REAL  CON 

dimension  DESS AV  (<..50)  .UESELO(S.SO)  .DESVERl  nOO)  .PCTAB0(500. 1 ) 
DIMENSION  TRNSAVIA.NOELD?) . TRNELD (S.NOFLOZ) . TRNVEM (2.T0TVT|) 


. . mon.3)  .VR(iOOO)  .OUT(lOOO)  .ILINEO)  .BUE(  110.20) 

. JSTATiPO) ,PCrAB(NOTRFD.NOSU83) 

NCLUDE  cmskio.list 
NCL'lOE  C0'<MK6 

OMMON/GLOUAL/hEAO(63) .MAPTAP.DATAPE.SAVTAP.BMEILE.BMKEY. 

HISEIL .HlSKEY.TPFURM.ERIPTP.ERPKtY.MAPUNT.NOFILE. 
DRUMAn.ORMWDS.PftGSfZ.DATFIL.STAFlL.ASAV.ASAVFL 
.NHSTUN.NHSTFl .SCTRUN.MAPEIL 

.DOTUNT.DOrElL.NCHPAS.TRNSFL.BMTRFL.HlSTFL.PCMUNT. 

CRDUNT.PRTUNT.RANUIO 

COMMON/D I SPL/C A TFLG . C A TN AH ( o 1 ) « CLSNAM (61). SURNAM (61). SUBNO ( 60 ) . 
SUBCAT(60) .CL5SUH(60) . NOMAP. TOTVT3.NOSU83. 
PCFDKY.TSTKEY.TRNKEY.TMRSKY.STATKY.EMPTRS.THRSVA. 
PLTKEY.HMFLG.RMCOMa.BMFE AT. COATE (2) . 
FLDSV2.riELD2.vFRTX2,FLDSV3.EIEL03.VERTX3.PCT103. 
TmkES(SO)  .SYMMTX166) .HlGMi60) .vQN(6Q) 
.FLDKtY,NOFl.OP.NOrL03.NOFET2.F£TVC2l30) 


DIMENSION  FORMAT (3.2) 


DSP( 

m 

osPoSi 
Dspoo; 
DSPOOJ 
OSPOO’ 
DSPOOI 
OSPOI 

irissL  , 

toSP00}3( 
6sP0( 
Q|po( 
MPOL,- 
0SP00370 
DSP00380 
DSP00590 
OSPOOAOO 
OSPOOAIO 
USP00420 
DSP00<»30 
OSP00<»4O 
OSP00450 
QSP00<.60 

6spoo<»ro 

DSP00480 

DSPOO<»90 

DSP00500 

PSPOOSIO 

yspooslo 
OSPOOS30 
DSP00540 
OSP00S50 
OSP00S60 
OSP00570 
QSPOOSBO 
DSPO^SRO 
OSP0C600 
OSP00610 
DSP00620 
0SP00630 
OSP006<.0 
OSP006S0 
OSP00660 
pSP00670 
OSP00G60 
OSP00690 
PSPC0700 
OSP00710 
OSP00720 
-n<;pn!>  »30 
OSP007<.0 
DSP00750 
0SP00760 


FILE  0SPLV2 


DATA  FORMAT/ 
DIMENSION  I? 


T/*UMtV*»»CRSA»*»L 

i^TAI^|(66>»VR*THRES 


•«*LARS*t'YS  I**»I 


TRNN0*N0^UB3*I 

TSTNO«NOSUR$«Z 

$ET  POINTERS  FOR  SYMBOLS  ARRAY  ANO  TOTALS  ARRAY 

OUPNO  • NOSUR3*} 

OESUNIb  NQSUfl3»4 
OESOTHs  n0SUB3*S 

FLAG  USED  IN  DOTPCT  TO  INITIALIZE  PCTAB«0 
PCTKEY»0 

CODE  ADDED  NOV  13*1978  TO  INCLUDE  LIST  PROCESSING 
FLOCNT  ■ 0 

IF  inOTKEY.EO.O)  GO  TO  17 


IF  inOTKEY.EO.O)  GO  T< 
DO  16  I > 1.209 
LW  » (I  • lJ/1? 

LR  ■ (LR  ♦ 1»*10 
LS  « (LR  - l)/10  ^ . 

LS  * 10*(I  - (LS*19») 
TRNVER(l.i)  ■ LS 
ThnivER(2*I)  ■ LR 


ONTINUE 

ONTiNUE 


88  18  i:l:3Sf8?a 

PCTA0(J.I)  • 0 


PRINT  OUT  HEADING 


20  PeA9(MAPTAP)PLUlNF.PTS.LINES*FLOESC  ' 

Jf  (PTS  .GT,  1000)  W«ITE(6*c25 
F (PTS  .GT.  1003)  STOP  . . 

ORmatC  DISPLAY  MILL  ACCEPT  ONLY  1000  PTS/SCAN  LINE*I 
ISTRT»SAMSTR 

|eno*samend 

IF  (PTS.EQ.O)  CC  TO  310 


OQ^^^S*  Ul.OESOTH 
TTOL(I)*0 


25  TOTALS(I)>0.0 

PRINT  OUT  THE  COLUMN  NUMBERS 


30  J ■ 0 

CALL  SETmRG(68«0«68) 
IF(NOMAP.EO.O)GO  to  85 


wWTFG»l 
GO  TO  370 
poTFG»l 
GO  TO  SIO 
85  continue 
SPKNT*0 
COUNTR«0 
0RUMLN»0 
LAST«0 

ST ART*. FALSE. 
FULL  *. false. 

Ii:i 

I3«3 

J«1 

ADkES«DRUMAO 


DSP009 


OSP0133O 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
OSPO 
DSHD 
OSPO 
OSPO 
DSPO 
DSPO 
DSPO 

OUGt 
01490 
01500 

- olsio 

USPOi520 


FILE  DSPLY2 


r* 

C« 

r* 


91  READ(MAPTAP»  ILlNE ( J) * < IP (I « J) • I>1 .PTSl * ( VR ( I ) « I>1«PTS) 
IFdLlNE(J)  .CO.eiGO  TO  105 


DSP01530 


IS 


OSPO 

designated  fields  have  been  input#  set  the  ir  array  for  pixels  dspo 


c« 

c* 

c# 

c* 

r* 

c» 


those  fields. 

IF (DESKEY.EO. 1 ) CAi  l OESIGI ILINE ( J>  « IR ( 1 « J) «DESSAV*DESFLO«OESVER# 
NOrLOAtSAMSTR.SAMENO.SAMiNC) 

00  100  Isl#PTS 
L » IR(f#J) 

Tf(l.eq.o)Go  to 

fF(I..EO.NOSUB3)i 
IF(L.6T.N0SUB3)< 


THESHOLOING 


DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 

DSPO 

OSP01690 

OSP01650 


THE  VALUE  OF  THE  QUADRATIC  FORM  MUST  BE  EXTRACTED  FROM  VR  FOR  TMREOSPO 

DSPO 

0 « -2*VR  - CON  DSPO 

DSPO 
DSPO 
DSPO 


C* 

C* 

C* 


IF«THRSKY.EO.O)GO  TO  95 

^ iF((-2.*VR(n-C0N(U).LT.  THRESILMGO  TO  95 

92  CONTINUE 

TTOL  » total  pixels  THRESHOLOEO*  BY  SUBCLASS 


r* 

8: 

c* 


L « 


N0SUB3 


TT0L(U  » TTOL(L)  ♦ 1 
1R<I»J)  * N0SUB3 


totals  = TOTAL^NO.  pixels  classified  into  each  SUBCLASS. 
INCLUDING  THRESHOLOEO  AND  OCSIGNATEO  OTHER  * OESIGNATEO  UNIOENT 


C* 

C* 

C* 


95  TOTALS (L) 
100  CONTINUE 


* TOTALS (L)  ♦ 1 


C* 

c* 

c* 


HAVE  3 LINES  BEEN  READ 

IF(STAPT)GO  TO  105 
j*j#l 

IF(J.LT.3)G0  TO  91 
STARTS, TRUE. 

60  TO  91 

SPATIAL  FILTERING 

105  IF(FILTER.EQ.O)60  TO  115 
i»2 

10<S  IF  ■ 


F(IR<I-1,I2)  .NE.  IR(I*1«12))  GO  TO  110 
F(IR(i,Il)  .NE.  |R(i.I3))  GO  TO  110 
F(|R(I,li)  .n£,  1R(|-1#I2))  GO  TO  llO 
F(1R(I.I?)  .EO.  tRd.IlMGO  TO  ^10 


[FdRd.in  .EO.  N0SUB3)G0  TO 
tCC=lRd.ll) 

■ “Ida) 


ICCsiRC 

iCKsIRC 

IFdCK.f 


ir 


no 


jE0.N0SUB3)G0  TO  1 
totals  dcc)  = roTALS(  ICC) 
totals ( I C<)=T0TALS(ICK) 

SPKNT=SPKNT*1 
JRd.12)  = lRd»Il) 

IF(I.LE.PTS-1)G0  TO  106 

GET  performance  FOR  LINE  II 

CODE  ADDED  NOV  13.1978  TO  INCLUDE  LIST  PROCESSING 

if  (DOTKEY.EQ.O)  GO  TO  90 
CONTINUE 

TEST  TO  SEE  IF  THE  CURRENT  LINE  CONTAINS  ANY  DOTS 

IF  (ILIMEdl)  .GT.TRNVER(2.N0FLD2) ) GO  TO  119 
0CNT  * 0 
ECNT  * 0 


0 

738 

DSPO 1790 
''*■'''‘^750 

760 


DSPO 

8Ip01770 

DSPO 1780 


DSPO 


DSP01800 

DSPOIBIO 

OSP01B20 


DSPO 

DSPO 


DSPOIBSO 
86' 


590 


680 
690 
■ 0 


790 


630 

890 


DSPO, 

ospola  . 
DSP01880 
DSPO 1890 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 
DSPO 

DSPO 

DSP02000 
DSP02010 
OSP02020 
DSP02030 
DSP02090 
OSP02050 
DSP02060 
0SP02070 
OSP02080 
OSP02090 
DSPOalpO 
Dspoano 
DSP02I20 
DSP02130 
DSP02J  ‘ 
DSPO? 
DSPO* 
DSP02170 
DSP02I80 
DSP02190 
DSP02200 
DSP02210 
DSP02220 
OSP02230 
OSP02290 
DSP02250 
DSP02260 
DSP02270 
DSP02280 


FILE  0SPLY2 


IF  (1l1NE(II).nE.TRNVER(2»I))  60  TO 
IF  CfiCNT.EO.O)  aCNT  » I 
60  TO  41 

IF  (flCNT.EO.O)  60  TO  41 
ECNT  a I-l 
60  TO  43 

Ip'^nUNEdl)  .NE.TRNVER«2»N0FLD2))  60  TO  114 
ECNT  » N0FL02 

^I^Mil^cil.EO.O.CALL  PCTnLINE,Il).|Rn^ 
^IF(TSTKEY.E0.1)CALL 
IF  (NOMAP. EO.O)  GO  TO  135 


42 

41 


r* 

c* 

c* 

c» 

43 

40 

114 


c* 

C**»  CODE  ADDED  NOV  13tl978  TO  INCLUDE  LIST  PROCESSING 
^ IF  (DOTKEY.NE.O)  GO  TO  117 

c* 

c* 


117 


C* 

C* 


g: 

c* 


OUTLINE  TRAINING  AND/OR  TEST  FIELDS 

1F(TRNKEY.E0.1)CALL  FL0P0R(TRNN0»ILINE(II) ♦ IN H t II ) jNQFL02» 

• » . . i , THNS A V , TRNVER • N0SUB3 ♦ S AMSTR ♦ S AMEND » 

*IF (TSTKEY .EO. 1 ) CALL^FLbbOR dSTNOt ILINE (Il)»IR(lfIl) »N0FLD3» 

**  tstKo*tstsav.tstver»nosub3»samstr»samend» 

*SET  UP  SYMBOLS  FOR^THis^LlNEi  FIRST  MAKE  SURE  I/O  FROM  LAST  LINE 
is  completed. 

DO  120  1=1. PTS 
L = IR(I.Il)  . „ . _ 

IF(L.EO.O)OUT<I»=«LANK 
IF (L .NE , 0 ) OUT < I > =SYMMTX (L) 

120  CONTINUE 

WRITE  first  110  samples  ON  LINE  PRINTER  AND  THE  REST  ON  DRUM 


■!Ji 


TPTS=PTS 

IF(IPTS.GT.110)IPTS 
IF(PTS.LE.110)GO  TO 
1PO=PTS-110 
IF (FULL) GO  TO  1?5 
CALL  RW'RITE(ADRtS» 

ADhES=ADRES*IPD 
DPUMLN=DRUMLN*1 

IF(A0WES*IPD  .LE.  DRUMAD»DRMW0S)G0  to  125 
125  WRITE (6?240) ILINEC ID . (OUT (I) .Isl.IPTS) 

r* 
c* 
c* 

c*  , 

135 


.OUT(lil) .IPD.LSTAT) 


IS  CLASSIFICATION  MAP  TO  BE  OUTPUT  IN  UNIVERSAL  OR  LARSYS 
FORMAT 


C» 

C* 

C* 

C« 

C* 

r# 

155 


C* 


IF  (MAPFMT  .LE.  0)  60  TO  200 

CHECK  TO  SEE  IF  LAST  WRITE  IS  COMPLETED 

GO  TO  (155.160).  HOREC 

WRITE  HEADER  RECORD 

NC  a I 
LNES  = 0 
FEAT  = 1 
LSTLIN  = 0 
HDREC  =_2 

CALL*'wRTMED’(NC^.FaT. PTS. MAPFMT. MAPUNT) 


DSP02290 

DSP02300 

DSP023l0 

DSP02320 

OSP02330 

DSP02340 

D5P02350 

DSP02360 

DSP02370 

DSP02380 

DSP02390 

OSP02400 

DSP02410 

DSP02420 

OSP02430 

OSP02440 

DSP02450 

DSP0246Q 

OSPQ2470 

0SP02480 

OSP02490 

DSP02500 

DSP02510 

DSP02S20 

OSP02530 

DSP02540 

DSPO2550 

OSP02560 

OSP02570 

DSP02580 

DSP02590 

DSP02600 

DSP02610 

DSP02620 

OSP02630 

DSP02640 

DSP02650 

DSP02660 

DSP02670 

OSP02680 

DSP02690 

DSP02700 

OSP02710 

DSP02720 

DSP02730 

05P027<»0 

PSP027SO 

DSP02760 

DSP02770 

DSP02780 

DSP02790 

OSP0260U 

OSP02810 

0SP02820 

DSP02830 

DSP02840 

DSP02850 

OSP02860 

DSP02870 

OSP02880. 

DSP02890 

DSP02900 

DSP02910 

OSP02920 

OSP02930 

DSP02940 

OSP02950 

OSP02960 

DSP02970 

DSP02980 

05P02990 

OSP030Q0 

PSP03010 

OSR03020 

05P03030 

DSP03040 


FILE  0SPLY2 


» WRITE  DATA  RECORD 
» 

•;f  LNES  « LNES  ♦ 1 

200  continue 

IF(ILINE(13) .EO.OIGO  TO  201 
» SET  INDICES  AND  GO  READ  NEXT  LINE 


till! 

I3«J 

GO  TO  91 

LAST  LINE  IN  THIS  FIELD  HAS  BEEN  READ.  HAKE  SURE  LAST  2 LINES 
ARE  PRINTED. 

LAST*LAST*1  

1F(LAST.E0.2»G0  TO  203 


ADWtS=AOPES  ♦ KPTS 
215  IBUf=IHUF*I 

IF  ( I0UF,GT.NPUFS> 10UF»1 
IF(LINE.LE.LINEN0)G0  TO 
AOsAO  ♦ LPTS 
GO  TO  219 
220  CONTINUE 


0SP03 
OSP03 
O'"*' 


:♦  NOR  FINISH  PRINTING  MAP  FOR  THIS  FIELD. 

:• 

IF^ImaPFmT  .GT.  0)  WRITE(6»22O0)NOFILE.FLOESC.tFORMAT(I.MAPFMT). 

2200*FOWMSTi///fss!VlLE  NO.,  , -*  !l&»/T55,'FIELD  NAME  - •,  A4,/ 

• T5S.*F0RMAT  - • .3A4./T55. 'NO.  RECORDS  - •♦I6» 

IF  (NOMAP  .LE.  0 ) go  TO  230 

IF(PTS.LE.110)GO  TO  230 
AOsO 

N0UFS=2O 

IF(NBUFS.GT.LINES)NBUFS»LINES 

KPTS=PTS-110 

lpts=iio 

NWDTHS=KPTS/nO 

IF(MOO(KPTS.I10> .NE.O)NWOTHS»NWOTHS^l 
LASTPC=MO()(KPTS»IIO) 

IF(LASTftC.EO.O)LASTRC=UO 

fsO 

219  I»I»1 

IF  (I.GT.NWDTHS)  go  TO  220 
LINCNT»0 
WRTFG»2 
GO  TO  370 

221  PRTFG*2 

GO  TO  510 

222  CONTINUE 

IF  ( I .ECJ.NWOTHS)  LPTS*LASTRC 
A0RES=0RUMA0  ♦ AO 
DO  205  Jsl.NHUFS 

CALL  RREA0(ADRES.BUF(1#J) .LPTSt JSTAT ( J> ) 

ADRES=ADReS*KPTS 
LINCNT=LINCNT  ♦ 1 
205  CONTINUE 

LINE=LINSTR 

IflUFsI 

C*  finished  READING 

210  IF(JSTAT(IBUF)  .EO.DGO  TO  210  . . 

RRlTE(6.?40)LlNEt (BUF ( IK. IBUF ) ♦ IK*^  .LPTS) 

LINF  = LINE  ♦ LINING 
LINCNTsLINCNT*!, 

Tf(lincnt  .gt.  drumlnigo  to  215  , 

CALL  PREAO(AOWES.BUF(l .I8UF) »LPTS» JSTAT ( IBUFI 1 


FILE  0SPLY2 


240  FORMAT(*  *.I5.2X.U0An  OSP03810 

I^i^lLTEP.EO.OIGO  TO  230  OSP03820 

— WRITE (6.305) SPKNF  DSP03830 

305  FORMAT(/«  THE  CLASSIFICATION  OF»»I7»*  PIXELS  WAS  CHANGED  AS  A PESUOSP03840 

2^  SPATIAL  FILTERING*/?  OSP03850 

230  CONTINUE  OSP03860 

250  CONTINUE  OSP03870 

C*  OSP03880 

C»  PRINT  CLASSIFICATION  SUMMARY  FOR  THIS  FIELD  DSP03890 

^ CALL  SETmRG (68.4,62)  o|p039l8 

CALL  PPTSUM(TOTALS.TTOL.FLOESC)  OSP03920 

IF  (DOTKEY.EO.O)  go  to  500  OSP03930 

C*  OSP03940 

designated  area  or  not  in  the  classified  area  will  0SP039S0 

C«  HAVE  PCTABOsO  0SP03960 

C OSP03970 

C***  CODE  ADDED  NOV  13  .1978  TO  INCLUDE  LIST  PROCESSING  OSP03980 

C DSP03990 

255  CONTINUE  DSP04000 

C*  OSP040l0 

C DSP04020 

WRITE  (6.5)  OSP04030 

5 format  HHl)  0SPC4040 

DO  7 CHPCT=1.N0FL02  DSP04050 

IF  (PCTABO(CHPCT.I) .LE.N0SUB3)  GO  TO  8 OSP04060 

WRITE  (6.4)  TPNVFP(1.CHPCT).TRNVEP(2»CHPCT)  DSP04070 

4 FORMAT (//3X.  *UOT  (•  . 14.  • ,*  . !4.  * ) IS  IN  THE  DESIGNATED  ARDSP04080 

*EA*  ) OSP04090 

PCTAPD(CHPCT.l)  a 0 DSP04iQO 

GO  TO  7 DSP04110 

8 F (PCTABO(CHPCT.l) .GT.O)  GO  TO  7 DSPOAlJO 

WRITE  (6,2)  TPNVER(l,CHPC7) ,TRNVER(2.CHPCT)  OSP04130 

2 format (//3X,  *OOT  (•  , 14  , • ,*  , 14.  * ) IS  NOT  IN  THE  CLASSIF10SP04140 

•EO  AREA*  ) OSP04150 

7 continue  OSP04160 

WRITE  (6,5)  0SP04170 

C OSP04180 

C***  CODE  ADDED  NOV  13,  1978  TO  INCLUDE  LIST  PROCESSING  DSP04190 

C 05P0420Q 

FLDCNT  a FLOCNT  ♦ 1 DSP04210 

CALL  LISTSM(70TALS.TT0L*  DSP04220 

* PCTAB0,GTUNIT,GTFILE.AIUNIT,AIFILE.  USP04230 

* PPUNIT,PPFILE,NAMECT, ALP. FLOCNT,  DSR04240 

* NOCAT, CATNAM,SU3CAT,N0FL02.N0SU32»SUBNAM)  DSP04250 

C 0SP04260 

C DSP04270 

C DSP04280 

500  CONTINUE  DSP04290 

GO  TO  20  DSP04300 

310  CONTINUE  * DSP04310 

RETURN  DSP04320 

C OSP04310 

C self-contained  SUBPOUTINE  to  print  HEADERS  DSP04340 

C DSP043S0 

f , DSP04360 

370  WRITE  (6, HEAD)  OSP04370 

WRITE (6, 3H0)FLDESC, COATE  DSP04380 

380  FORMAT  ('  DISPLAY  OF  CLASSIFIED  FIELD *,A4/  DSP04390 

* ' CLASSIFICATION  DATE *,2A4)  DSP04400 

IF(BmELG.GT.O) WRITF(6,390)8MCOMS, (FETVC2(L) .Lsl.BMFEAT)  DSP04410 

IF (BmflG.EO.0)WR1TE(6,400)  (FETVC2 (L ) .L»1 .NOFET2)  DSP04420 

CALL  MAPHD  (NOCAT, SYMMTX,CATNAM,KATN0,CLSNAM,SUBN0,SUBNAM,  OSP04430 

* CLSSUH.N0CLS2.N0SU')2,THRSKY.THRES)  OSP04440 

IE(DESKEY.En.l)WPITE(6,4lO)  SYMMTX  ([^ESUNI ) OSP04450 

410  FORMAT {/5X, ***  DESIGNATED  FIELDS  SYMBOL  IS  '.Al/)  0SP04460 

390  FORMAT(12X, ‘CLASS  EICATION  CHANNELS .,.*. 12. • LINEAR  COMBINATIONS  ODSP04470 

*F  CHANNELS'/J8X.  3013)  DSP04480 

400  format(12x,*classification  Channels... *.3013)  DSP04490 

GO  TO  (31 .221 ) .WPTFG  DSP04500 

C»  DSPC4S10 

r*-*-*-*-*-*-*-*-*-*-*-*-**-*-«-**-*-*-*-»-*-4-*-*-*-*-»-*-*-*-*-*-*-*-*-»DSP04525 

c*  0SP04530 

C«  INTERNAL  ROUTINE  TO  PRINT  COLUMN  NUMBERS  DSP04540 

„ OSP045S0 

510  JsO  OSP04560 


->oo 


r»o  r»ooor>r»r»r> 


•ILE:  EMTHRS 


1 


I 

T 

1 


SURROUTINE  FMTH«S(FLnSAViFIELOtVERTEX.NOFLn)  EMTOOOIO 

>EMT00020 

EMTOOOaO 

This  SUhhuOTINE  is  usf.o  only  when  the  empirical  threshold  OPTIONEMTOOOaO 

RFOUESTEO  tMTOOOSO 

OR  IF  HISTOGRAVS  of  the  QUADRATIC  FORM  WERE  REQUESTED  WITH  SOME  EMT00060 

OTHER  THRESHOLDS  EMT00070 

TMT00080 
_ 090 

EMTOOlOO 
EMTOOnO 

t?0 


ISI88 


IMPLICIT  INTEGER  <A-Z) 

REAL  VR*nSFHNC*THRES*CON 
TNCLUriP  COMMKG.LIST 
INCLUDE  CMm«10,L1ST 

C0MM0N/GLUHAL/HEAn(63) tMAPTAP»0ATAPE«9AVTAP«RMFILE*RMKEY» 

H ISF IL. H I S^EY.TRFORM,ERIPTP.ERPKEY.MAPUNT^ NOFILE* 
DPliMA0,riWMu(0StPA6SlZ*0ATFlL*STAFiL»ASAV*ASAVEL 
.nhstun.nwstfi .SCTRUN«MAPFIL 

.D0TUNT,0GTHL,NCHPAS.TRNSFL*BMTRFL.MISTFL»PCHUNT* 

CWOUMTfPRIUNT.HANUIO 

rOMMnN/OISPI./CftTFLG.CATi*AM(6l ) «CLSNAM<61»  ,SURNAM(6l ) »SUPN0<60)  « 
SUHCAT (HO) .CLSSUB(ftO) *NOMAP» TOT VT3.N0SUR3. 
PCFDKY.TSTKEY.TRNKEY»THRSKY.STATKY.EMPTRS»THRSVA* 


C9EMD 

10 

c« 


c* 

r» 

r. 


30 


40 


c* 

f« 

c* 

r* 


HLTKEYtBMFU6,HMC0M8iBMFF AT.CDATE (2) t 
PLUS  V?*FlEl.0P*veRTX2.FLnSV3,FlELD3.VERTX3*PCT  103* 
THWES(HO) .SYMMTX (fift) ,HIGH(HO) .CON (60) 
»FLr)KFY.NOFLD2.NOFLD3»N0FET?fFETVC2(30) 
.NOSU^2.mOTHFO.TOTVT2.NOCLS? 

,KATNO(60) .NOCAT, FILTER. MAPFMT 
.dfs*<fy,oesuni,oespth,crop  , ACP0P,A0THER*AT0TAL 
.SI TF (6) .ANALYSIS) »CAM( 15) ,CRPKEY,KEPPTS (60) 
.nOTKEY.OOTERR 

Data  range/Mo/ 

Or-'ENSION  OSFUNC  ( 1 00.60)  * IP  ( 1000)  . VR  ( 1000)  .FLDINF  (6)  , SCR  AT  (500) 
FOitlVAl.FNCF  (SCHAT.IR) 

PE AU(MAPTtP) FLDINF  . PTS , L INES ♦ FLDESC 

IF  (PTS.FU.  ft)  GO  TO  40 

nn  30  1=1. lines 

PFAD(MAPT4P) ILTNE. ( I»( J) , J=1 »PTS) , (VR(J) ,J»1,PTS) 

HISTOGROK  VP  wJTmIN  CsROUND  TRUTH  FIELDS 

CAUL  PCTT  ( 11.  T NF.  m.VH.  FIELD,  VERTEX.FLDSAV.DSFUNC.NOFLO, 

• FLDINF (4) ,FL0INF(5) ,FL0INF(6) , CON, RANGE) 

CONTINIJF 

PFAD  END  OF  FI  FLO  RECORD  AND  GO  SEE  IF  THERE  IS  ANOTHER  FIELD 
PEAn(MAPTAR) u INE 
GO  TO  1C 

ALL  FIELDS  ON  THIS  FILE  HAVE  SEEN  PROCESSED  NOW  PLOT  THE 
CONTINIJF 

CALL  OISTCV (OSFUNC, SCRAT, RANGE) 


EMT00130 

EMT00140 


NOW  GO  RACK  TO  RFGINNIN6  OF  THIS 
FOUR  HFftOER  RECORDS  - GETTING  IT 

RFwiNn  «artap 

CALL  FSSSFL (MaoTAP,4, ISTaT) 


FILF  AND  POSITION  TAPE  OVER  THE 
READY  DSPLY2 


<;oo 

?in 


IF  (ISTM  .NT 
F0P«4T ( • FRWOM 
TF  (ISTAT  .ST. 
nn  Pin  J=1.4 
PFAn((-*APTAP) 

return 

FNO 


0)  wRITF(6.snO)  ISTAT 
RACK  SPACING  VAPTAP* .' ISTAT  = 
n)  CALL  CmfRR 


IS) 


MT00150 
HT00i6O 
EMTOO] 
EMTOO 
EMTOO 
EMTOO. 
EMTOO. 
F.MT00220 
EMT00230 
EMT002A0 
EMT00250 
FMT00260 
EMT00270 
EMToolno 
EMT00290 
EMT00300 
EMT00310 
EKT00320 
EMT00330 
EMT00340 
EMT00350 
ER.T00360 
EHT00370 
EMT00380 
EMT00390 
EMT00400 
EMT00410 
EMT00A20 
EMT00430 
EMT004A0 
EHT00450 
EMT00460 
EMT00470 
MISTOGRAMEMT00480 
EMT00490 
EMT00500 
EMT00510 
EMT00520 
EKT00530 
EMT00S40 
EMT005S0 
EMT00S60 
EMT00570 
EMT005G0 
EMT00S90 
EMT00600 
EMT00610 
EMT006P0 
EMT00630 
EMT00640 


riLFt  FOIST 


?: 

C- 

8- 


SUBROUTINE  FOIST 

ROUTINE  TO  U«?E  FISHlN  TO  GET  THRESHOLD  VALUES 


DIMENSION  F(60) 


INCLUDE  CMPKIO.LIST 

C0MM0N/niSPL/CATEL6.CATNAM(61) fCLSNAM 


(61) *SyRNAH(6l) *SU 

i; 


tCOATEI 
.FIELD 
))  *CON 


SUBNO(NO) < 
THRSVA* 


VERTX3.PCT103* 
(60) 


ri>ENn 
c- 
c- 
c- 
c- 
c- 


|UBCAT(60> *CLSSUB(60) tNOMA 
PCFDKY.TSTKEV.TRNKEY.THRSKY 
RLTKEY*eMFL6»BMCOMH*BMFEAT.t 
FLnsV2<,FIELO?.VERTX2,FLDSV3. 

THRES(60) ♦SYMMT* (66) fMlGHjftO)  

♦ FLn*'EY»NOFLD2.NOFLO3»NOFET?,FETVC?(30) 
*N0SiJ42«N0TRF0.T0TVT2tN0CL§? 

♦ !<4TN0(6n)  .NOCATtFlLTERtHAPFMT 
fPESKEY.OESUNl.DESOTHtCROP  « ACROPt AOTHER«ATOTAL 

♦ SITE  (6)  ♦ANALYS(S)  fCAHdS)  fCRPKEYfKEPPTS  (60) 
♦DOTKEY^OOTERP 


NOSIJH?  3 NOMPEM  OF  SUBCLASSES 
THRFS(I)  CONTAINS  INPUT  CONFlOl 


ENCE  LEVELS 


8: 

C- 

C- 

c- 

c- 


c- 


c- 

c- 

C“ 

c- 

c- 

C- 


10 


PO  10  IsltN0SUP2 
F(I)«1-THRES(1) 


NX  = 
NOFFT?  = 


Nl/MflEP 

NUMBER 


OF 

OF 


samples 

channels 


compute  threshold  values  using  fisher  f-distribution  funtion 

no  20  T=l.Nn5uB2 

FX  a KFPPTS(I) 

NS=kFPPTS(1)-nOFET2 


TFI  AGrO 

VAPaF  IS.1IN  (F  ( I ) ♦MOFETPtNSt  IFLAG) 
IF(IFLAfi.F.ij.l)  GOTO  15 

FK  a( N0FET2*{FX-l)*(FX*l) )/(NS«FX) 

THRES(I)  » FK«VAH 

GO  TO  ?0 


THRFSHOLO  -.ILL  PE  SET  TO  999. S99  IF  OVERFLOW  OCCURS  IN  FISHIN. 


C- 

C- 

C- 


IS  THRFS(na999,999 
V'RTTF(6.ll)I 

11  FOOMAT(^X. 'FOIST-  OVERFLOW 

]Srt,u,«,  threshold  set  To 


FO 

FD 

18 

FO 


00010 
00020 
00030 
OOOAO 
00050 
FOI00060 
FOI00070 
CMBOOOiO 
CMB00020 
CMB00030 
CMBOOOAO 
CM8000S0 
CM600060 
CH600070 
CMBOOOBO 
CMBT 
CHB(  . 

CMBOOU 

CMBOOltO 

FDI00090 

[001 


FD 

FD 

FD 


condition 

999.999') 


IN  FISHIN  ROUTINE  FOR 


?n  CONTINUF 

PFTURN 
FNM 


FD 
FO 
FO 
FD 
FD 
FO 
FD 
FO 

E8 

FD 
FO 
FO 

SUBCLASFO 

FDI 

FO 

FD. 

FDI 

FDI 


10 

20 


oopo 
ooUo 

OOlSO 
00160 
oopo 

OOIRO 
00190 
00200 
..00210 
FDI00220 
FDI00230 
FDI00240 

■ 00250 
00260 

.00270 
FD1002R0 
FDI00290 

■ ‘00300 
00310 
00320 
00330 
00340 
00350 
00360 
00370 
003A0 
00390 
00400 
00410 
00420 
00430 
00440 
00450 
00460 
00470 

.00480 
FDI00490 
FDIOOSOO 


1‘ILP!  FISH 


2 


1 


3 

in 


A 


7 


FUNCTION  FlSM(F,NlfN2) 

i.orital  ' ■ 

Fls.FALS 
F2«.FaL» 
f3*.FALl-- 

1F(M00<N1,2) ,EQ.O)  E1».TRUE. 
1F(M0D(N2.2)  .EO.O)  E2».TRUE. 
X»N2/<N2*M*F) 

IFC.NOT. (FI. OR. 

TF(E1 .ANO..NOT.  _ 
IF(.NOT.El.AND.E2) 
1F(N1.LE.N2)  60  “■ 
r*wi 

N1>N? 

N2*I 
x«l.n-x 
F3».TOUF. 

Y*1.0-X 

Pl<M*n.o 

H»SQRT(X**N?» 

MsNl/2-l 


60 

TO 

E2) 

60 

TO  1 

E2) 

60 

TO  2 

TO 

1 

Ts-1 

f"  (}.6T.»<)  60  TO  10 
FI*5H=F1SH*H 

H*(H*r*(N2»?.»I) )/(2.*(I*l.) ) 
60  TO  3 
IF(E3)  60  TO  A 
FI*;hs1.0-F1SH 
RETURN 
I»N1 
N1xN2 
N>xl 

return 

Y=1 ,0-X 

Hs.6^6^1‘>7  7*S0RT  (X«Y) 
FI«,H=.ftT6hl‘J77*AHCOS(S(3RT(X>  ) 
TF(N2.FiJ.l)  60  TO  H 
MeN2-2 

no  6 I s 1 . . 2 

FI6H=EISH»M 
HsH*X* (I* 1 ) / ( r*2) 

IFCNl.E';.!)  RETURN 

M*Nl-2 

no  7 1 = 1. *S2 

FICHaFlSH-H 

Msw*y*(n2»I)/(I*2) 

RETURN 

ENn 


FISOOOlO 
F 

ISOOOAO 
IS00050 
>00060 
>00070 


>00160 

>00190 

,i00200 

S00210 


F1S00340 


S00350 
$00360 
S00370 
Sn0380 
S00390 
.$00400 
F1S00410 
F1S00420 
' S00430 
$00440 
$00450 
$00460 
$00470 


FIS004H0 


IS00490 

$00500 


^20 


file:  FISMIN 


1 


2 


3 


4 


s 


6 

7 


FUNCTION  FISHlN(ALPHA«NltN2tlFLAQ) 


TF(N1.» 


V2xl 


.FO.l) 

IF(N2.FO.n 
X.TINOPM { 1 .-ALPHAt IFLAO) 
TFdFLAG.EU.l  > GOTO  6 
Y«(X**2-3.»/6. 


IC»0 

vSi./i 


(Yl-l.) 

- . (Y?-l,) 

H*?./(Yi*Y2) 
XbX*SORT (M*Y) /h 
XsFXP(2,*X» 

. 

IP1=? 

1F(N00(N1»2) ,EQ.0» 
Gal .7724535 

TBlal 

lF(?^niN2.2) .fO.O) 
,772453N 


(Yl-Y2>*(Y*5./6.-2./(3.«Hn 


GO  TO  1 


fiaR*}.- 


GO  TO  2 


rF(fiOn(Ni*N2,2)  ,eo.o) 

PaR/1.772451<) 


GO  TO  3 


TR3=1 

IF( (iPl ♦IH?! .NF.2) 


IF(  (Nl*rv2)  .LF.3) 
N0=N1 ♦N2-2-TH3 


60 


Ga2.*G 

TO  5 


la-? 

|xl»? 

IF  (f.GT.NO)  60  TO  5 
IF(  (IHI  ♦! ) .LF.  «NI-2) ) 6BG*(lRl»n 
!F((IR?*I).I  K,(N2-2))  6aG*(IP2*n 
Gar,/ (1^3  ♦ 1) 
r,n  TO  4 

Y?sN2/ (N2*N1 «x) 

Yl=l ,-Y? 

Yal (G*(l .-alpha-fish (X»Nl.N2) »> /SORT ( Yl««Nl*Y24*N2) 
F15HlNaX*Y 

IFIY.LT.O.)  FISHINa,R*X 
1F(ahS<x/FISH1N-j.).LT.(.SE-6)»  60  TO  7 

IFIARRIX-FISHINI .LT. <,5E-6) > GO  TO  7 
1C«IC*1 

IF(IC.GT.IOO)  RETURN 

XaFI<;HI^4 

GO  TO  « 

IFI.  AGal 

RFTUR»4 

FNP 


SOOOlO 

S00020 

S00030 

S00040 

SOOOSO 

$00060 

S00070 

$00080 

$00090 

$00)00 

imt 

$00)30 

500)40 

SOOlSO 

500)60 

$00)70 

$00180 

$00190 

$00200 

$00210 

$00220 

m 

$00260 

$00270 

§00280 

S00290 

$00300 

$00310 

§00320 

$00330 

1500340 

500350 

500360 

500370 

1500380 

1500390 

500400 

500410 

500420 

500430 

1500440 

1500450 

1500460 

500470 

500480 

500490 

500500 

500510 


FILEi  FLOBOR 


C* 

C« 

C* 

C» 


C* 

c* 

c* 

c* 


c* 

c* 

c* 


c* 

c* 

c* 


?n 

in 


c* 

c* 

c« 


4n 

45 


44 

47 

=.0 


SU«POiJTiNE  FLDHOw(ISYM,L1NUM,1R,NOFLO»F1ELD»FLOS*V» VERTEX* 

» n0SU83«SAHSTR*SAHEN0*5AHINC*L!N1NC) 

THIS  subroutine  sets  THE  SYMBOL  INDEX  IN  THE  CLASSIFIED  LINE 
ARRAY  TO  OUTLINE  TRAINING  OR  TEST  FIELDS  IN  THE  MaP. 


(IR) 


implicit 

niMENSTON 


lNTF6ER(A-2) 


, _ IH<1)  .FIELD(S.NOFLO)  ♦FLOSAV(A*NOFLDI  .VERTEXd) 

DIMENSION  FL(2?) 


no  SO  lal.NOFLn 
IFfLlNUM*LINlNC  .LT,  FIELOdf 
1F(LIMIIM-L1N1NC  .GT.  FlFLOCZ. 
IFJFIFum.I)  .GT.  SAMENO)GO 
IF(FIF.L0(4*n  .LT.  SAMSTH)60  TO 


TO 


60 

GO 

SO 

50 


TO 

TO 


50 

50 


(J) tSAMINC) > IB«IB*1 


FOUND  ft  FIELD  THAT  NFEOS  ROROER  ON  THIS  LINE.  NOW  FIND  FIELD 
INTERSECTIONS  ON  THIS  LINE. 

NV*ELnSAV(4.n 

TPT=FIELO(S.n 

TOP  OR  hOTTOM 

IF<LlNUM.GT.FIELO(?*inGO  TO  40 
IF(LIM)M.LT.FlELO(l»inGO  TO  30 
CftLL  FOL  rn  ( vertex < IPT ) ,NVtFL*LINUM*SAMPS.NI> 
no  20  J*l»NT.2 
ID  c(FL(J)-SftMSTR)/SAMlNC 
IE»(FL( J*1 >-5AMSTR)/SftMINC  ♦ 2 
lF(Mnn(SftMSTO,SAMINC) .NE. MOD (ELI 

POPNUHsISYM 

IF(IR(Ih) .GT.NOSUB3)flORNUM  ■ N0SUB3  ♦ 3 
lR(fH)=HORNUP 

IFdR(lE)  .6T.N0SUB3)B0RNUM  s NOSU03  ♦ 3 
IR(IF)=pORNUm 

GO  TO  sn 
CONTINUE 

GET  INTERCEPTS  FOR  TOP  LINE  IN  FIELD 

CftLL  FOLInT  (VERTEX (IPT) .NV*FL. F lELO d . I ) tSAMPStNI ) 

GO  TO  45 

GET  INTERCEPTS  FOR  BOTTOM  LINE  IN  FIELD 

CftLL  FHLIUTCVERTEXdPT)  .NV.FL»FIELO  (2. 1 ) *SAMPS*NI ) 
no  47  jxj ,NT,2 
IB  = (FI.  (J)-SAVSTR)/SAMINC 
IE  = (FL (J*1 )-SftMSTR)/SAMINC  ♦ 2 
IF(moO(SAM5TP.SAMINC) .NE.MOD(FL(J) »S AMINO  » 18»IR»l 
no  44  TJsIh.TF 

BOonumsISYH 

IFdetiJi  ,GT.N0SUS3IB0HNUMbN0SUB3*3 
TP(IJ)sP0RNUM 
CONTINUE 
CONTINUE 
RFV.iHN 
ENU 


ELOB0720 


FlLf.l  LISTPR 


THIS  SU«»OMTInE  rjPlNTS  LffEL  lifCLS 
SUHPOuTTNt  ListP*)(ISlT*OOTLlB* 
jHPLlCtt  !NTCriEe_(4-7) 


220 


JATa 

niwEN 


ITYPEtSUBLAS) 


. 

120 

130 

230 

20 

30 

215 

216 


ANK/»  •/ 

«5UBLAB(!9*11) «LINE2(19) 
LAB(l9«li«4) 

.-ilT 

^ * 

NPPT  ■ 6 

WPITf  (NPpf.lO)  ■. 

FOPMATdH]) 

rOPM|T(//?boJj  •GHOUNS^WUlM^i  LABELS*} 

r 

FOHMAf(//isV»(i»fYP|''»»|U*  DOT  CLASSIFICATION*) 

MMlTf <NPPT«3n)  (I*I>}0«|90«I0) 

F0WM#T(//,l?Ktl9(I 
DO  200  1*1. U 

DO  ?15  J ■ l»57 
LlNf(J»  » BLANK 
DO  216 

L1NE2U) -PLANK 
on  ??0  J-1.19 

.-3-<j-n 

‘(ll*I)»dotlab(j» 

(LI  ♦3)=l)0TLA8 
IF  (OOTLAB(J,l  . 

.?  - LINE(U  ♦ 2) 


urrnu  I I ^ 9 A 9 * uF9v/u*^u  I in  kMDbws’i 

MinhlVdl  j!*IUK§^0i"2iASSIFIEO  LABELS*) 

1TF(NPPT.?0»  ITYPE  

* - *.I1  * 


un  gi 

LINE 


lF(LL?TNr;sC»SH> 
1F(LU?.i‘ 


LAB(J.Itll) 
LAB(J*I«I|) 
J.1.11) .NE. 


BLANK)  LINEILL  - 2)  * SLASH 


3) 


BLANK 


P(LL?.nF.SLASH)60  . 

LINE2(J)«SU8LA8<J.I) 

CONTINUE 

l^lTt  IINPRT.300)  I10»  <LINE(KK).KK-1.57)  * (LlNE2(KK)  *KK-1*19) 
FON><AT(//.9X.I3,lSMlXtlA2tlAl«lA2)  «/tl2K«l9(lX*lA4*U)  ) 
rONTlNUf 


PE. 

END 


im 

SOOflp 
S0007< 


S00360 
SOOJ" 

h 

S003B0 

S00390 

SOOAOO 


L1S00430 


uuu 


FILE  LISTSM 


*•••• 

*•••• 


SySWOUTiNE  LISTSMlTOTALStTTOLtPCTABtGTUNITi  _ 

• gTriUEtAlUNlt.AIFlLEtPPyNlT»PPElLE*NAM^CTfALB# 

• FL0CNT*NCAT«CATNMtSUBCAT*NFL02«NSUB2«$UBNAMT 

(A-f) 

JMIJ 

r.NATEI 


IMPUCIT  INTE6EH  (A-2) 


subroutine; 
M and  r ar 

0 IS 
NAMECT 
THE  CAT 


WRITTEN  NOV  1978  TO  INCLUDE  LIST  PROCESSINO 
E BOUNDARY  DOT  NAMES 

THE  dEsignateo  name 

“ S The  name  of  THF  'SMALL  GRAINS  • , 

60HY  CLASSIFIER  MUST  HAVE  BEEN  INVC 


COMMON  /LISTMM/  NPGA(3.?)  «NAHP6A(?09O«2)  tLINP6A(209«3tZ) 
• SAHPGA(209y3«2)«OOTLAR(209tAt2)*VP6AI3)*IPOA 
:23*5678 

5 INCLUDE  CRBKIA 

: Include  comrki 

COMMON/ lNFOHM/NOCLS2»NOSue2*NOFCT2.VARS72»TOTVT2»NOFL02# 
AVAR2*COVAR2.CLSin2.SUPNO?.SUPDS2.FLDSW2fVERTA2* 
FFTVC?<30J  .SUPVCaiH)  *SUHPTH(7S)  ICLSVC2I60)  t 
kERPTSiAO) .NOGHP«GRPNAM<60>  fGRPOEFIAl) t 
6RPCMK ( 6 1 > . GROUPS n 24 1 

COMMON/nOTVEC/TYPE»CATNAM(60>  »N0CATiT0TVEC«FL0INFI6} * 
PHTKEYfSIZE.LAClE 


CSENO 


D 1 MENS  ION  ALPMS6 ( 3 1 1 SUflN aM ( I ) , SUBL  AB  C 209) 

OATA  SYMTMP/'«'/fSYMDES/'  */♦  SYMOUT/'  »/t 
MBCD/'M*/tRRCO/»R'/«OHCQ/'D '/.BLANK/'  '/* 
ALPMSG/'PPC  '.'OT  •♦•Al  •/ 


C 

V 


10 


DIMENSION  TTOL<n .PCT AB < 1 ) .CATNM ( 1) ,SU8CaT ( 1 ) , 

* FlELOS(A,250) . VERTEX < 1000) . INFUNT J3» .INFFILIJ) 

REAL  TOTALSm  .ALP*-^) 

CODE  AOOEP  TO  PRINT  OOT  PERFORMANCE  SUMMARV 

REAL  RS . VRS . BC  . VBC  » TRMl  . TRM3 « ALPSUM, PG ♦ ci-P 
real  SUM,BA^rE,OtJlTOT(60>  .LABTOTI60)  .TOTCATIGO) 

REAL  ALPHA ( IS) .TRM2 

THIS  CODE  ADDED  TO  PRINT  CONFUSION  MATRIX  N»N 
DIMENSION  CONF (60.60) .OOTNUM(209.2) 

RFAL  P54ACH(2)  .PIXTOT.PI  1 .P12.P81  .P82.P.CATT0T  161 ) 

CONTINUE 

IF  (FLDCNT.GT.l)  60  TO  400 

' initialize  if  FIRST  FIELD  TO  BE  SUMMARIZED 

no  10  I = 1.3 
DO  10  II  = 1*2 
NPGAd.fl)  » 0 
0(J  |0  I » 1,2 
DO  20  II  * 1.3 
00  ?0  III  « 1.209 
NAMPGAdt  1*11*1)  a 


nOTLAB(ill.Il.I) 

CONTINUE 


BLANK 

BLANK 


PF40  IN  PPC  OT  Al  FILFS 
ASSUME  TYRE  1 AN!)  2 ON  SAME  UNIT 


f ack-to-back 


IF  (PPUNIT. 

0) 

GO 

TO 

2S 

!PGA  a 

IPGA 

♦ 

1 

VRGAdP! 

r,A ) 

= 1 

25 

IF  CGTUNir. 

F.Q. 

0) 

GO 

TO 

30 

IPGA  a 

IPGA 

4 

1 

yPGAdl 

PGA) 

S 

? 

30 

IF  ( A I UN  I T . 

(:0« 

0) 

60 

TO 

35 

IRGA  a 

IPGA 

4 

1 

III! 


j0036( 

hi: 

50039Q 

S0040Q 

l8i:p 

S00430 

S00440 

ISItl 

$00470 

!i| 

soosio 

soolo 

soosso 

SO0S60. 
S00S7O 
S00S80 
S00S90 
S00600 
S006' 
S006_ 
S0063 
S00640 
S006S0 
.S00660 
IS00670 


L 
L 
L 
L 
L 
L 
L 
L 
L 
L 
L 

LIS006B0 

lIsootoo 


gg 

w 


ISOOTIO 
100720 
, 100730 
S00740 
S007SO 
IS00760 


;'N?L  PAGt 


flLC  LISTSM 


35  ir  (IPOA.EO.O)  CAU  CMCDf) 


NfUNT { 
NFF1L( 
NFUN?  < 
NFFIL( 
NFUNT ( 
NFFIL( 


: 8IW 

: .‘iW 


- I 

- I 

- I 


400 


PCTAS  stored  in  order  of  first  line*— second  line  etc. 


|ue< 


405 


410 


N5UB3  > NSUB2  * 1 
NSUB6  ■ NSUR2  ♦ 5 
NSUV  ■ NSUH2  * 6 
00  Ho  I > 1.NFL02 
3K  ■ RCTABdl 
. (SUBCL.6T.0)  GO  TO  405 
?0TLAB<I.4tH  ■ SYMOUT 
0 TO  420 
F (SUBCL.LE.NSUR2)  60  TO  41 
F ISUMCL.E0.NSUB31  OOTLABJ 
F (SUBCL.EQ.NSUH6.0R.SUBCL 
GO  TO  420 

CAT  • SURCAT (5UHCL) 
D01LAB(|t4tl » » CATNMjCATJ 
( I t4«2) 


.C^SUBT)^ 


VMTMP 

'0TLAB(It4.n 


■SYNDES 


420  OOTLAR 


■ rnTLAB(I.4»I) 


SURL  AH  ( I > -SURN AM  ( SlIHCL ) 

IF ( SUHCL . eo. NSUbG . OR . SUBCL . EO.NSUB7 ) SUBt^B ( I > ■SYHDES 
430  CONTINUE  W 


440 


445 


COMPUTE  TOTAL  NUMBER  OF  CLASSIFIED  DOTS 

PlXTOT  « 0, 

DO  44U  I s }*NSUH2 
PlXTOT  ■ PUTOT  * TOTALS(I) 


COMPUTE  total  mo.  of  PIXELS  IN  EACH  MACHINE  CATEGORY 
COUNT  UP  PIXELS  OF  CHOSEN  AND  OTHER  CATEGORIES 


PMACM(l) 

PMACH(2) 


0. 

0. 

DO  445  I « 1*61 
CATTOT(I)  =0.  A 

DO  450  I « 1.NSUH2  Ir 
CAT  * SUHCATin 

CATTOT(CAT»  « CATTOT(tt|T)  ♦ TOTALS(l) 
CAINM<CAT>  ^ 

".NArttCT)  GO  TO  448 


OUM 


448 

450  . 

:?34567H«» 
:•••  ncat 
[•••  ICAT 
123456789 


if  ( UUM.NE.t 
CAT  » CAT 
HACH(I)  s 
GO  TO  450 
PMACH(2)  a 
CONTINUE 


CAnfifftCATI 


CATTOT(CAT) 


NO.  OF  MACHINE  CLASSIFIED  CAT^RIES 
CATEGORY  NUMBER  OF  PREFERRED  ^TEGORY 


Pmach(I) 

PMACH(2> 

!•••  major  loop 


» PMACHd  l/PIXTOT 
r PMACH(?)/P!xTOT 


DO  600  I ■ ItlPUA 


COUE  ADDED  TO  PRINT  CONFUSION  MATRIX  N*N 


15 


15  !L*i.60 
rfor<TL>»o 


no  . 

OOTI 

continue 

SUHbO 
no  22  IJ=1.2 
DO  ?2  lK.1,209 
OOTNUH(Ik*IJ)sO 


S00770 

IS8II3 

SQOHOO 

soobIo 

S00820 
sooelio 
S0084 

tooes 

00R6 
S0087 
*0088 
0089 
0090 

881 

009_ 

t0094 
00950 
S00960 
$00970 
100980 
09990 


070 
SOiOSO 
S01090 
SOilOO 
501)10 
501)20 
501130 


_I501140 
LISOl 150 


SOI  160 
501170 
S01180 
501190 
S01200 
50)210 
501220 
501230 
501240 
01250 
01260 


270 

80 

90 

300 

310 


SO 

fo 

50 
SO 
SO 

501320 
50)330 
SOI  340 
501350 
SO  1360 
501370 
501380 
501390 
501400 
S01410 
501421 
S01430 
S01440 
S01450 
501460 
50U70 

LIS01430 

LIS01490 

LlSOlbOO 

LISOISIO 

L1501S20 


<'■  i'-iNM.  PAOK 
('!'  (H'AI.l 


FILE  LISTSM 


C 

C 


22  CONTINUE 

,„,ISIT  a VPGA(I) 

IPT  aO 
STAMNT  = I 
TYPE  a I 
NOCAT  a 0 
N0FL02  a 0 
TOTVT2  a 0 
TOTVEC  a 0 
SWCH6  a 0 
INIT  = 0 

110  - LISTLC  (FIELDS. STAMNT. M30. LIAO. *.150. SWCH6# 

• INIT.INFUNT(ISIT) .INFFIL(ISIT) .IPT.VERTEX) 

130  NP6A (ISIT.TYPE)  a N0FL02 

NAMPGA(N0FLn2.ISIT.TYPF»  a FIELDS ( 1 .N0FL02) 
LINPGA<N0FLD2. ISIT.TYPE)  a FLOINF(l) 

SAMPGA(N0FLD2, ISIT.TYPE)  a FLDINF(A) 

110  = FL0INF(1)/10 
1110  a FLl)INF(A)/10 
J a (!10  - 1)*19  ♦ 1110 
OOTLAFHJ. ISIT.TYPE)  a F lELDS ( 1 .N0FL02) 

CODE  ADDED  TO  PRINT  CONFUSION  MATRIX  N*N 

IF(TYPE.E0.1)G0  to  110 
DO  13S  JJ=1, NOCAT 

IF (nOTLAB(J, ISIT.TYPE) .EQ .CATNAM { JJ) ) OOTNUM( J. I ) ajj 
CONTINUE 

IF<noTLAG(J.ISlT.TYPE) .EQ.fiLANKiGO  TO  110 
SUM  = StJM*l 

IF(OOTNUM(J.l) .EQ.O)OOTNUM(J.1)=NOCAT*1 

GO  TO  no 

DOT  TYPE  change 

N0FL02  a 0 

NOCaT=0 
go  TO  no 

send  CARO  IMAGE  DETECTED 
150  CONTINUE 

COUu  mOOED  TO  FIND  CATEGORY  TOTALS  FOR  DOT  REPORT 

DO  155  JJ=1. NOCAT 
TOTCAT(JJ)aO 
DO  155  JK=1.NCAT 

IF (CATNAM (JJ) .E0,CATNM( JK) ) TOTCAT ( JJ) =CATTOT ( JK) 
CONTINUE 

CODE  ADDED  TO  FIND  DOT  LABEL  CATEGORY  NUMBER 
DO  160  JJal.20-9 

IF  (PCTAB(JJ)  ,F(J.NSUB3)GO  TO  160 
IF (PCTAH( JJ) .F0.NSUB6)G0  TO  160 
IF (PCTAB( JJ) ,FO.NSUB7)GO  TO  160 
DO  160  KK=1. nocat 

IF(00TLAB(JJ,4,2)  ,E(3.CATNAM(KK)  )D0TNUM(JJ.2)aKK 
CONTINUE 

IF  (NPGA(ISIT.l) ,FO.O)  60  TO  505 
ITYPE  a 1 

CALL  LISTPR ( ISIT.DOTLAR. ITYPE.SUBLAB) 

505  IF  (NPGAdSIT.2)  .EO.O)  GO  TO  600 
ITYPE  = ? 

CALL  LISTPR(ISIT,D0TLAB(1.1.2) .ITYPE.SUBLAB) 


C 

c 

c 


135 


C 

C*»* 

c 

lAO 


C 
C 


c 

c 

C 


155 

C 

C 

C 


160 


c***  compute 

c 

Nil  a 
N12  = 
N?l  a 
N22  a 
NHl  a 


Nn.N12,N2l.N22,NRl,NR2  FOR  TYPE  2 DOTS 

0 

0 

0 

0 

0 


LIS01590 


S01530 

S015A0 

S015S0 

S01560 

S01570 

soisao 


S01600 
S01610 
501620 
S01630 
S016A0 
.S01650 
1501660 
IS01670 
LIS01680 
LIS01690 
LIS01700 
LIS01710 
LIS01720 
L1S01730 
LIS017aO 
Lisoirso 
LiS0l760 
l!S0177O 
LIS01780 
LIS01790 

Lisoiaoo 

LIS01810 

LIS01B20 

LIS01830 

LIS01B40 

L1S01850 

LIS01860 

LIS01870 

LI501880 

LIS01890 

LIS01900 

LIS01910 

LIS01920 

LIS01930 

LIS019A0 

LIS01950 

LIS01960 

LIS01970 

LIS01980 

LIS01990 

LIS02000 

LIS02010 

LIS02020 

LIS02030 

LIS020A0 

LIS02050 

LIS02060 

LIS02070 

LIS02080 

LIS02090 

LIS02100 

L1S02110 

LIS02120 

LIS02130 

LIS02140 

L1S02150 

LTS02160 

LIS02170 

LIS02180 

LIS02190 

LIS02200 

LIS02210 

LIS02220 

LI502230 

LIS02240 

LIS02250 

LIS02260 

LIS02270 

LIS02280 


FILE  LISTSN 


NB2  >0 

CODE  ADDED  TO  PRINT  CONFUSION  MATRIX  N*N 


510  IJ-lt60 
510  1K>1«60 


510 


512 

C 


C 

C 


C 

C*** 

c 


c*** 


00 
DO 

CONFilK.IJ) 

CONTINUE 
DO  512  IJslt60 
OOTTOT«1J)=0 
LABTOT(IJ)»0 
CONTINUE 

IF  DOT  PROCESSING  SKIP  LIST  REPORTS 

IF(NAMECT,EQ.8LANK)60  to  582 

DO  580  II  = 1»209 
OHM  a NAMPGAdI  .TSIT.2) 

IF  (0UH.NE«NAMECT»  60  TO  530 

DOT  LABEL  IS  PREFERRED  CATEGORY 


OUMS  = 
OUML  = 
00  S15 
DO  SU 


SAMPGAdl.TSIT, 21/10 
LlNPfiAdl.lSIT. 21/10 


iii.Viii. 


C23456789 

IF 


_ J9 

IF(IIII.NE.nUMS)  GO  TO  5U 
lFdII.NE.nUML)  60  TO  5U 
FOUND  machine  CLASSIFIED  DOT 
J = (III  - 11*19  ♦ IlII 
DUMA  = 00TLAH(J*4»21 
JF  (OUM.EO.DUMA)  Nil  “ NI 


(OUMA.tO.SYMDES)  60  TO 


ill 


514 

515 

C 

C*** 

C 

530 

C 

C*** 

C 


534 

535 


C*** 

c 

550 

C*** 


(OUMA.EO.SYMTHPl  GO  TO  514 
IF  (OUMA.EO.SYMOUTI  60  TO  514 
IF  (DUM.NE.OUMA)  N12  * N12  ♦ 1 
CONTINUE 
CONTINUE 
60  TO  580 


IF  (dum.ne.mbcd.and.dum.ne.rbcdi  go  to  550 
this  pixel  was  labeled  boundary 

DUMS  = SAMPr,AdI,I51T,?)/10 
OUML  = LlNP6A<IIdSITi2)/10 
DO  53S  Id  s 1,11 

DO  534  nil  = 1,19 
IF(ini.NE.nUMS)  60  TO  534 
IF  dIl.NE,rU)ML)  60  TO  534 
J = (III  - 1)*19  ♦ IIII 
DUMA  = OOfLAB (U,4,2) 

IF  (DUMA.EO.NAMfcCTl  NBl  a Nfll  ♦ 1 
IF  (dUMA.EO.SYM DES)  60  TO  534 
IF  (DuMA.ED.SYMTHPl  GO  TO  534 
IF  (OUMA.EO.SYMOUTI  GO  TO  534 
IF  (DumA.nE.NAMECTI  N82  a NB2  ♦ 1 
CONTINUE 
CONTINUE 
60  TO  580 

THIS  PIXEL  IS  labeled  DESIGNATED  OR  IS  IN  THE  OTHER  CATEGORY 

IF  (OUM.F J.DHCD)  go  to  580 
IT'S  IN  the  other  category 
OUMS  = Samm(;a  ( n , IsTt, 21/10 
OUML  a LInP6A(II,ISIT, 21/10 
nn  55S  Id  3 1,11 
no  554  I d I 3 1*19 
IF  (I  1 1 I. ME ,nUM5)  GO  TO  554 
IF  dIUNF.DUML)  GO  TO  554 
J a (III  - d*19  ♦ dd 


[S02290 
S02300 
502310 
502320 

_ Eo23?0 

L1S02350 
IS02360 
IS02370 
[S023RO 
[$02390 
S02400 
S02410 
S02420 
[$02430 
S02440 
[S02450 
[SO2460 
[S02470 
S02480 
S02490 
S02500 
S02510 
1S02520 
IS02530 
IS02540 
ISO2S50 
IS02560 
IS02S70 
S02580 
IS02590 
LIS02GOO 
L1S02610 
LIS02620 
LIS02630 
LIS02640 
LIS02650 
LIS02GftO 
LIS02670 
LIS026R0 
LIS02690 
LIS02700 
LIS02710 
LIS02720 
LIS02730 
L1S02740 
LIS02750 
LIS02760 
LIS02770 
LIS02780 
LIS02790 


L 

L 

L 

L 

LI 

L 

L 

L 

LI 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L_ 

LI 

L 

L 

L 

L 


S02H00 

502810 

S02820 

S02830 


LIS02840 


S02H50 

S0?«60 


LIS02870 


S02880 
S02890 
S02900 
L S02910 
L S02920 
L S029J0 
LIS02940 
LIS02950 
LIS02960 
LIS02970 
LIS02980 
L1S02990 
L1S03000 
LIS03010 
LI50J020 
L1S03030 
LIS03040 


flLr  LISTSM 


OUHA  s D0TLAR(J«4«2) 

IF  (OUMA.FQ.NAMFCT)  N?1  a N2l  ♦ I 
IF  <0UHA,£O,SYMI)ES>  60  TO  554 
IF  (OUMA.EO.SYMTHR)  60  TO  554 
IF  ( OUMA.EQ.SYMOUT)  60  TO  554 
IF  (OUMA.NE.NAMECT)  N22  a N22  ♦ 1 

554  CONTINUE 

555  CONTINUE 
580  CONTINUE 

C 

€••*  COMPUTE  PROPORTION  OF  PREFERRED  CLASS 
^23456789 

Pll  = FLOAT (Nil) /float (Nil  ♦ N21  ♦ NBl) 

P12  = FLOAT (N12) /FLOAT (N12  ♦ N22  ♦ NB2) 

PBl  = FLOAT (NRl) /FLOAT (Nil  ♦ N21  ♦ NBl) 

PB2  = FL0AT(NP2)/FL0AT(N12  ♦ N22  ♦ NB2) 

P = PMACH(l)*(Pil  ♦ ALP(1)*PB1> 
p s p ♦ PMACH(2)*(P12  ♦ ALP(2)*PB2) 

C 

WRITE (6,9R0)  ALPMS6(ISIT) 

WRITE(6*1000)NA'".ECT 
WRITE(6.1050)  PMACH(l) ,PMACH(2) 

WRTTF(6.1005) 

WRITF  (f.tl010)Nl  l.Nl?tN21.N22 
WRITF(6.1020)NB1*NH2 
WftITFCbf 1030) 

WRITE (6, 1040)  Pll*P12tP01«PB2»P.ALP(l) *ALP(2) 
60  TO  675 


990  format (1  HI.*  TYPE  II  DOT  REPORTS  FOR  LIST  PR0CESSIN6* ♦ * 
1 • VS  MACHINE  CLASS*) 

1000  format (IHO.*  PHOPORTION  SUMMARY  FOR  CATE60RY  1 = ‘tlAA) 
1005  format (2X. 'CLASS* .5X. • 1 * . 5A . • 2 • . / . 2X . 'LABEL') 

1010  format (4X, » 1 ' .?X.2( IX, IS) ./.4X. •2»»2X,2(1X»I5) ) 

1020  F0PMATt4X,'R',2X,2(lX,15)) 

1030  format  (lriO,»  Pll  P12  PBl  PB2  P ALP 
1040  FORMAT (IHO. 7(2X,F6, 4) ) 

1050  FORMATdHO,*  R(l)  = ',F7.4,'  P(2)  = ',F7,4) 


C 

C CODE  ADDED  TO  PRINT  CONFUSION  MATRIX  N«N 

C 

582  TOP=NOCAT*l 

DO  S90  JJ=1.209 
LAB=nOTNUM(JJ,l) 

IF (LAB. to. 0) GO  TO  590 
IF (LAH.EO.TOP) GO  TO  S85 
LAB  TOT (L A8>  =LABTOT (LAB) ♦! 

58S  CLS=D0TNUM(JJ,?) 

IF (Cl  S.EQ.O) 60  TO  590 
OOTTOT (CLS) =POTTOT (CLS) ♦! 

IF (LAH.FO.TOP)GO  TO  590 
CONF (LAB.CLS)=CONF (LAft.CLS) ♦! 

590  CONTINUE 

c 

C WRITE  CONFUSION  MATRIX 

C 


•«A4, 


•) 


WRITE  16.2000) 

2000  F0RMaT(1H1.2X.'TYPE  II  DOT  REPORTS* ,//.2X, 'CONFUSION  MATRIX*) 
STCAT=1 
FNOCATsNOCAT 

IF  (F'inCAT.GT.15’EN0CATsl5 
TIFES=N0CAT/16 

IF (MOO (NOCAT. 15) .NF .0)T1MES=TIMES»1 
DO  595  JJ-l. TIMES 

WRITE (6.2010) (CAINAH(KK) . KK=STC AT . ENDC AT ) 

2010  format (/.3X. 'CL  ASS' .5X, 1A4. 14 (2X.1A4) ) 

WPTTF (6.2012) ALPMSGI ISIT) 

2012  format  (3X.  *./,3X,lA4,' LABEL*) 

DO  610  KK=l,NnCAT 

WRITE (6.2020)CATNAM(kK) , (CONF (KK.LL) .LLsSTCAT»ENDCAT) 

2020  format (AX, 1A4. 151b) 

610  CONTINUE 

STCAT=STCAT*I5 

ENDCAT=nOCaT 

IF  (ENnCAT.GT.STCAT*14)ENDCAT=STCAT*U 


LIS03050 

L1S03060 

LIS03070 

LISO3OB0 

LIS03090 

LIS03100 

LIS03110 

LIS03120 

LIS03130 

LIS03140 

LIS03150 

LIS03160 

LIS03170 

LIS031H0 

LIS03190 

LIS03200 

LIS03210 

LIS03220 

LiS03230 

LIS03240 

LIS03250 

LIS03260 

LIS03270 

LIS03280 

LIS03290 

LIS03300 

LIS03310 

LIS03320 

L1S03330 

LIS03340 

LIS03350 

LIS03360 

LIS03370 

LIS03380 

LIS03390 

LIS03400 

LIS03410 

LIS03420 

LIS03430 

LIS03440 

LIS03450 

LIS03460 

LI503470 

LIS03480 

LIS03490 

LIS03500 

LIS03510 

LIS03520 

LIS03530 

LIS03540 

LIS03550 

LIS03560 

LI503570 

LIS03580 

LIS03590 

LIS03600 

L1S03610 

L1S03620 

LIS03630 

LIS03640 

LIS03650 

LIS03660 

LIS03670 

LIS03680 

LIS03690 

LIS03700 

LIS03710 

L1S03T20 

LIS03730 

LIS03740 

LIS03750 

L1S03760 

LIS03770 

L1S03780 

LIS03790 

LIS03800 


'I'd 


FILE  LISTSN 


595  CONTINUE 


Ui 


- Is 
Ql-\I 


rrv 


c 

3000 


7*0 


30?0 

730 


CODE  ADDED  TO  PRINT  ALPHA  VALUE  MATRIX 
WRITE(6*3000) 

FOPHaT (//* ax «« ALPHA  VALUE  MATRIX*) 

STCATal 

ENDCATsNOCAT 

IFCENDCAT.6T.15)ENDCAT«15 
DO  7?0  JJ=lt TIMES 

WPITEI6.2010) (CATNAM(KK) *KKaSTCAT*ENDCAT) 
WRITE (6.aoia»ALPMSGIISIT) 
no  730  KKsl.NOCAt 
DO  7*0  II=STCAT«tNOCAT 
IP (nOTTOT (in .EO.O) ALPHA { I I>STCAT*1) «0 
IE(OOTTOT(1I)  .EU.OGO  TO  7*0 
ALPHA ( I I-STCAT* I ) =CONE (KK. 1 1 ) /DOTTOT III) 

continue 

L=ENOCAT-STCAT*l 

WRITE(6*30a0)CATNAM(KK), (ALPHA (II) *IIsl«L) 
E0RHAT(*X«lA<(taX.15F6.3) 

CONTINUE 

STCAT=STCAT*15 

ENOCATsNOCAT 

IF(ENDCAT.GT,STCAT*1*»EN0CAT=STCAT*1* 

CONTINUE 

CODE  ADDED  TO  PRINT  DOT  PERFORMANCE  SUMMARY 


C 

c 

WRITE(6ta030) 

2030  format (//t2X» ‘DOT  DATA  PERFORMANCE  SUMMARY*) 

WRITE  (6.203S) 

2035  formati/,sx,icategohy'.9X»*classified**iox«(Bias  corrected  *. 

1 •PrtOPORTiUN'tiaXf'RANDOM  SAMPLE  PROPORTION* t I IXt 

2 'VARIANCE') 

WRITE  (6.203P) 

rORMATITX,  'NAME'* 12X, 'ESTIMATE '.1  OX f 'ESTIMATE* f lOX* 'VARIANCE  * * 
1 lOX t 'ESTIMATE '.lOX.' VARIANCE' »1 IX. 'RATIO') 


2038 

C 


c 

C 

c 


630 

625 


6*0 

635 


20*0 

650 

675 

2050 

600 


8ASE=PIXT0T*T0TALS(NSUB7) 

LOOP  TO  calculate  6 PRINT  SUMMARY  BY  CATEGORY 

DO  650  KK=1, NOCAT 
ALPSUM=0 

DO  6?5  1 1 = 1. NOCAT 
IEIPOTTOTIII),EO,0)TRM1=0 
lEinOTTOriin.EO.OIGO  TO  630 
TRMl =CONE (kk. 1 1) /DOTTOT ( I I ) *TOTCAT ( I I ) 
ALPSUMsALPSUM.TRMl 
CONTINUE 

RS=  ILARTOT (KK)/SUM)«(PIXTOT/BASE)*100 
VRS=RS*( (PIXT0T/5ASE) *100-HS)/(SUM-1) 

PC= ( ALPSUM/BASF ) *1 00 
VBC  = 0 

DO  635  LL=1. NOCAT 
TRM1=( (TOTCAT (LL) /BASE) *100) *»2 
IE  (DOT  TOT  (LU  .ED,  0)  TRM3=0 
IE (DOTTOT (LL) .Eu.O)GO  TO  6*0 
TRM2=C0NE (KK.LL) /DOTTOT(LL) 

T«M3=(TRM2*i 1-TWM2) )/ (DOTTOT ILL) -1) 

VPC=VRC*TRM1*TRM3 

CONTINUE 

PG=VRC/VRS 

CLP=TOTCAT (KK)/P1XTOT*100 
WRITE (6.2fl*0)CAlNAM(KKI  .CLP .BC . V8C »RS« VRS.PG 
FORMAT (RX. 1 A*.*X.6(6X»F«.*.4X)  ) 

CONTINUE 
WRITEI6.2050) 
format ( IHl) 

CONTINUE 

RETURN 

END 


LIS03810 

L 

SO3820 

L 

S0383II 

L 

SO3840 

L 

S038b(I 

L 

S0386Q 

L 

S03870 

L 

SO3880 

L 

S03890 

L 

S03900 

L 

L 

S03910 

S03920 

L 

S03930 

L 

S0394Q 

L 

S03950 

L 

S03960 

L 

S03970 

L 

S03980 

L 

S03990 

L 

S04000 

L 

S04010 

L 

S04020 

L 

S04030 

L 

S0404C 

L 

S04050 

L 

S04060 

L 

S04070 

L 

S04080 

L 

S04090 

L 

S04100 

LIS0*110 
LIS0*120 
LISO*130 
LI SO* 1*0 
LIS0*150 
LIS0*160 
LISO*170 
LIS0*180 
LIS0*190 
LIS0*2O0 
L1S0*?10 
L1SO*220 
LIS0*230 
L1S0*2*0 
LIS0*250 
LIS04260 
LIS04270 
LIS0*280 
LIS04290 
LIS04300 
LIS04310 
LIS04320 
LIS04330 
LIS04340 
LIS043S0 
LIS04360 
LIS04370 
LIS04380 
LIS04390 
LISU4400 
LIS04410 
LIS04420 
LIS04430 
LIS04440 
LIS04450 
LIS04*b0 
LI504470 
LIS04480 
LIS04490 
LIS04500 
LIS045I0 
LIS04520 
L1S04530 
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C 

C 


?00 

i 

i 

2in 

64 

2?n 


14 «; 
66 


70 


250 

7? 

24  0 

74 

?4S 

7*^ 

67 

6"» 

6« 


SUPHOIJTINE  MAPHO(NOCAT.CLSSYM«CATNAM,KATNO«CLSMTXtSUBNOt 

* «;ilBOES.CLSVC2»NOCLS2tNOSUH2tTHRSKY»THftES) 

THTS  90UTINF  POINTS  THE  HEADER  INFORMATION  FOR  THE  CLASSIFICATION 
MAP  IN  DISPLAY 

N0C4T  — NO.  OF  CATEGORIES 

ClSSYM  — SYMBOLS  FOR  CATEGORIES  OR  SUBCLASSES 
FATNA*'  — CATEGORY  NA«ES 

KATf.'O  — CATEGORY  EACH  CLASS  WAS  ASSIGNED  TO 
CI.SmTx  — CLASS  NAMES 

SUHmO  — NO.  OF  SUBCLASSES  IN  EACH  CLASS 
S iPOpS  — SUPCLASS  NAMES  , ^ 

CLSVC?  — CLASS  EACH  subclass  WAS  ASSIGNED  TO  (IN  COMMON 
BLOCK  TNEORM) 

IMPLICIT  integer  (A-Z) 

DIMENSION  CLSVCEU) 

PEAL  ThBES(I) 

LOBirnL  1‘4'^TH 

dimension  Cl  S5YM( 1 ) .CATNAM ( 1 ) .KATNO ( 1 ) .CLSMTX ( 1 ) *SUBNO( 1 ) f 

• So-iOESll) 

PRINTS  CATEGORY  CLASSIFIER  INFORMATION 

IF  (NOCAT  .LE.  0)  GO  TO  6? 

¥'RTTP  (*'.?00) 

EO°MAT(//  T4?.»wap  of  category  CLASSIFIER  CLASSIFICATION  RESULTS 
///  TIE. •CATP''-0KY»,Th?.*CLA5S'»Ty3. 'SUBCLASS’/  T31» 

• mO.  » . T ■'7,  ina^'E  » . T60.  'NO.  • • T66»  'NAME  • * 

TPt,  *:jO.  '.TR4,  'SYMBOL* ) 

IF  (THPCf  Y . 0)  «RIIE  (E.206) 

format  ( 1m-.,T10«,  *THBES.  • ) 


DO  60 


I =1 .NOCAT 


1 0)  T ,r  ATNAMU  ) 

31 . I2.T37, A4) 

TRUE. 

= l .'I0CLS2 

(J)  .'0.  I)  60  TO  64 

) SO  To  NS 
2") J. CLSMTX (J) 

Ip.T6-6.A4) 

T OF  . 

30)  -i.ClsmT X ( j) 

♦ .Tf^f’.  I2.T66, 44) 
=J.OOSO“? 

CP(K)  .E'i.  J ) GO  TO  70 


f 

c 

c 


WPTTE (6,? 

FORMAT (/T 

TSWTh  r . 

no  63  J 
IF  (KaTnO 
60  TO 
IF  (IS.Th 
V'RTTF  (6,2 
FORMAT (/ 

TSwT-i  = . 

CO  TO  66 
VPITF  (a.,2 

format ( 1- 

PO  67  K 
IE  ( CLRV 
00  TO  67 

MSUBCl  = SO --0(0) 

KK  = 0 

no  7S  L 

KK  = K ♦ 

IF  (IS‘-'Tb 
‘-•'OI  TF  (6.? 

FORMAT ( TB 
00  TO  74 
VRITF (6,2 
FORMAT  (!>- 
ISwTM  = . 

IF(THwRr  r 
FORMAT  ( 1*- 
FONT  1 00'^ 

F-0  Tn  6 3 
FOMTloOE 
rOMTINOE 
FOPTTNOE 
opTiJR  J 

PRINTS  SlANf'/ARn  FIASSIFIER  INFORMATION 


= 1 .:SOMCl 
L - 1 

) on  TO  7? 

) KK  .SOROES  ( KK  ) .CLSSYM  (KK) 
E.,T?.TR4  ,a4,T103,AI) 

^11)  KK  .SU-'OI  S (KK  ) .CLSSYM  (KK  ) 
♦.Tmf,I2,TR4,A4,T103»a1) 

FAI  SE  . 

.f  .0)  *RITF(6.24S)  ThwES(KK) 
♦,T16B,E6.3) 


MAPOOOIO 
MAP00020 
MAP00030 
MAP00040 
MAP00050 
MAP00060 
MAPO0070 
MAPOOOBO 
MAPOOORO 
MAPOOlOO 
MAPnoilo 
MAPU0120 
MAP00130 
MAP00140 
MAP00150 
MAPOOlbO 
MAP00170 
MAPOOIBO 
MAP00190 
MAP00200 
MAP00210 
MAP00220 
MAP00230 
MAP00240 
MAP00250 
MAP00260 
MAP00270 
MAP002B0 
MAP002R0 
MAP00300 
MAP00310 
MAP00320 
•MAP00330 
MAP00340 
MAPO03SO 
.■'4PO0360 
MAP00370 
MAP003B0 
MAE'003R0 
f'AP00400 
MAP  (1 041  0 
MAB00420 
6AP00430 
•■'AP00440 
MAP004S0 
MAP00460 
MAP00470 
PAP00480 
MAP004RO 
MAPOOSOO 
MAP00510 
MAP00S20 
MAPO0S3O 
MAP00S40 
MAPOCiSSO 
MAP00S60 
MAPO0S70 
mABOuSpO 
MAPOOSRO 
••'AP00600 

paroomo 

VAP00620 
MAPP0630 
MAP00640 
MAP006SO 
MnM'ObBO 
E'AP('0670 
MAi>f)n6B0 
MAPC06R0 
MflPOO/OO 
MAPonn  0 
PAR00720 
pAPon /30 
MAPC0740 
MAP007SO 
PAP0076CI 
K'APdO?  70 
MAPOn  7H0 
MApnn7R0 


FILF!  MAPHO 


rONTINUE 

wrTTF(A,2A0J 

260  F0PM6T(  //  T42*  ‘MAP  OF  STANDARD 

• S*  ///TaS« 'CLASS*  *T77t 'SUPCLASS*/ 
*T70.  'NAMF »*T85. 'SYMBOL') 
TF(THRS''Y.^'C■.fi>  WRITE  (6*265) 

2A5  FOBMATnH*tT93t*ThPE3.') 


CLASSIFIER  CLASSIFICATI 
T42»'NO.'tT50»'NAME*»T7 


ns 

?7o 

F7 

280 

an 

2«>S 

89 


CLSMUM  = 1 
ISWTH  s .TRtlF, 
no  ft9  1 = 1 .'■•OSIIH? 

IF  (CLSNUM.pJ,  CLSVC2(D)  GO  TO  85 
tlSNUM  = CLSMIJw  ♦ I 
r,0  TO  87 

IF  (ISWTH)  GO  TO  87 
w«ITF(6.?70)  I .SUPOESd)  »CLSSYM(I) 

FO^^M^(T7?. I2tT7n.A4fT87.Al) 

GO  TO  48 

W«ITFC6.2H0)CLSNUM,CLSHTX(CLSNUM)  .I.SUnOESm  fCLSSYMm 
FORMAT (/  TA2, 12.T50.A4.T72.I2.T78.A4.T87.A1) 

ISmTh  = .FALSE. 

IF  (THBSKY.NF.O)  WRITE  (6. 285)  THRESH) 

FORMAT ( IH..T93.F6.3) 

COMTiNtlE 

oftupn 


FNO 


MAP00800 
MAPOOAIO 
MAP00H20 
ON  RESULTMAP00830 
2»*NO.'t  HAP00H40 
MAP00850 
MAP00860 
MAP00870 
MAP00880 
HAP00890 
MAP00900 
HAP00910 
MAP00920 
MAP00930 
HAP00940 
HAP009SO 
MAP00960 
MAH00970 
MAH009A0 
MAP00990 
MAPOIOOO 
HAPOiOlO 
MAP01020 
HAP01030 
MAP01040 
MAP01050 
MAH01060 


flLPl  PCT 


C» 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c« 


c* 

c* 

c* 

c* 

r* 

c* 

c* 

c* 

c* 

c* 


r* 

c* 

c 

c 


c 

r 

c 

c 


c* 


SUnPCUTINE  PCT(LINUM,I«  .TIELO. VERTEX. FL0SAV»PCTA8tN0FL0t 
* SAMSTR.SAMENO.SAMINC) 

IMPLICIT  INTFGEP(A-Z) 

BUILDS  the  performance  TAHLF  for  display,  OP  THE 
histogram  of  the  QUADRATIC  FORM  FOR  EMPIRICAL  THRESHOLDS. 

ARGUMENTS : 

LINUM  - LINE  NO.  REING  TESTED. 

PTS  - NO.  OF  POINTS  IN  IR  ARRAY 

FIELD  - RECTANGULAR  COORDIANTES  OF  FIELDS  (TRAINING  OR  TEST) 
(S.NOFLO) 
l.LINF  start 

2- LINE  END 

3- SAMMLE  start 

a-sample  t^in 

S-POInTER  to  vertex  array  for  VERTICES  OF  THIS  FIELD 
VERTEX  - ARRAY  CONTAINING  VERTICES  FOR  ALL  FIELDS 
FLOSaV  - FIELD  INFORMATION 
(A.NOFLO) 

1 - FIELD  NAME 

2- CLASS  NO. 

3- SURCLASS  NO. 

4- KO.  OF  vertices 
PCTAR  - PFPFORMANCF  TARLE 

(NOFLO.NOSOF3) ) 

NOFLD  - NO.  OF  fields  TO  TEST 

TR  - ARRAY  CONTAINING  THE  SUBCLASS  NUMBERS  FOR  POINTS 
ON  THIS  LINF. 

S4MSTR  - beginning  sample  NO.  OF  CLASSIFIED  FIELD. 

SAMEnD  - LAST  SAMPLF  NO.  OF  CLASSIFIFD  FILED. 

SAM  INC  - sample  INCREMENT  USED  IN  CLASSIFY 


OIMENSION  FIELD (S.NOFLO) . VEHTFX ( 1 ) .FLOSAV (4.N0FLD) . 

• PCTAR(NOFLL'.I)  .IH(1) 

DIMENSION  VFC  (40) ,FL (22) 

OPT  = l 
GO  TO  S 

ENTRY  PCTTd.INDM, IP, VR, FI  ELD, VERTEX, FLOSAV, OSFUNC.NOrLO, 

* SAM, sTR  .SAMEND, SAMlNC, CON, RANGE) 

PEAL  D*;FUNC  (RANGE, SO)  »VR(1)  ,C0N(1) 

OPTS? 

5 CONTINUE 


FIND  NUMBER  OF  FIELDS  THAT  THIS  LINE  INTERSECTS 


TI  = 0 

on  in  i = i,NiOFi.r> 

IF  (LIMUM.LT.FIELDd,!)  ) GO  TO  10 
IF  (LINUM.r,T.FIFLD(2, 1)  ) GO  TO  10 
IF  (FIELD (3. I ) .GT.SAMFNO)  GO  TO  10 
IE  (FIELD(4,I) .LT.SAMSTR)  GO  TO  lo 
II  = 11*1 
VEC(II)  = I 
in  CONTINUE 

NON  CHECK  the  fields  OF  INTEREST  ( GIVEN  PY  •VFC»  ) 


IF  (II  .EO,  0)  GO  TO  3S 
DO  3n  J=1,II 
JJ  = VFC  (J) 

NV=FL0SAV ( A. JJ) 

TPTrFIFLtHS.JJ) 

FIND  INTERCCPT4  FOR  THIS  FIELD 

CALL  FDLP.T  ( VERTEX  (IPT)  ,NV  ,FL  ,L INUM, SAMPS, NI ) 

DO  3n  1 = 1, ,(T,? 

JB  = (FL(I)-SamSTR)/SAMInC  ♦ I 

JE  = (P^L  ( I *1  ) -S4MSTR) /SAHINC  ♦ 1 

IF  (MOD(SAfSTS .SAMINC) .NE.mOD(FL ( 1 ) , S AMINO 

IF(JI4.C,T.JE)00  TO  30 

no  ?0  K=JR,JE 

K2  = 1R(K) 

IF{K?.P0.n)60  TO  ?0 
GO  TO  ( IS, I R) .OPT 

IS  PCTAH(JJ.K2)  = HCTAfl(JJ,K?)  ♦ 1 
GO  TO  ?n 
IB  rONTIMJF 


•PCTT0620 

PCTT0630 


PCTT0670 

PCTT06B0 

PCTT06R0 

PCTT0700 

PCTT0710 

PCTT0720 

PCTT0730 

PCTT0740 

PCTT07S0 

PCTT07ft0 

PCTT0770 


PCTT07R0 

PCTT0800 


PCTT0B70 


or>r>"> 


FILFI  PCT 


OIVSN  • FLOSAVOtJJ) 

WA<;  THIS  PIXFU  CLASSIFICO  CORRECTLY 

lF(niV«iN.NF.K?)60  TO  ?0 
?\  L«10«<-,b*C0M(K2)-VR(H) ) ♦ O.S 
IF  (L  .LE.  0)  L » 1 
IF  ( L .6T,  9ANGE)  L » RANGE 
nSFUNC(L*l)IVSN)  a 0SFUNC(L*0IVSN»  ♦ l.O 
?0  CONTINDF 
in  CONTINUE 
TS  CONTINUF 
PETURN 

fiO  MOMF 


END 


PCTT0900 

PCTTORIO 

PCTT0920 

PCTT0950 

PCTT0970 


■ o;:lG'XAI.  TAGi' 
OF  aU 


IS 

lA' 


riLFt  PRTPCT 


SUBROUTINE  PHTPCT (FLOSAVtPCTABf NOFLO) 

PRTPCT  PRINTS  THE  F0LL0*<lN6  CLASSIFICATION  PERFORMANCE  TABLES 


C« 

C* 


1.  FIELD  RY  SUBCLASS 

2.  FIELD  HY  CLASS 

3.  FIELD  RY  CATEGROY 
A.  CLASS  BY  SUBCLASS 

5.  CLASS  BY  CLASS 

6.  CLASS  BY  CATEGORY 


PCFOKY»l 
F PCFDKY-I 
F PCFDKY«1  AND  CATFL6-1 


- IF  CATFLG-l 


CSEND 


C* 

c* 

c* 

c* 


10 


IS 

?o 


30 


implicit  INTE6FR<A-2) 

REAL  PCTT 
A Li  PC  T 

DIMENSION  ELDSAV(A.NOELD) »PCT AB (N0FLD«N0SUB3) tTOTSAM«200»  »BUF(60) 
INCLUDE  C0MPK6»LIST 

INCLUDE  CMB^IO.LIST  . _ - 

C0MM0N/GL0bAL/HEAD(63) ,MAPTAPtDATAPE»SAVTAPtBMFlLEtBMKEY« 

hiseil.hiskey.trfohm,eriptp.erpkey.mapunt»nofilf. 
DKUMfl0.0OMwt)S,PAGSIZtnATFIL»STAFIL*ASAV»ASAVFL 
.NHSTUN.NwSTFI.SCTRUN.MAPFIL  ,,  , 

,00TUNT.QOTEIL.NCHPAStTRNSFL»BMTRFL*HlSTFLtPCHUNT» 

CRDUNT  •‘’RTUNTfHANDIO  ^ « 

C0MM0N/DISPL/CATELG,CATNAM(61) ,CLSNAM(61 ) .SyBNAM(6l) «SUBNO(60) t 
SUBCAT  ((«-n)  »CLSSUB(60)  »NOMAPtTOTyT3.NOSyB3.__,,^ 
PCFDKY,TSTKEY»TRNKEY»THRSKY»STATKY*EMPTRS*THRSVAf 
PLT^EY.eMELG^BMCOMfl,B''FEATtCpATEii) 
FLDSV?tEIEL0?.VEHTX2,FLDSV3»FIEL03tVERTX3*PCTI03* 
THWES(60) ,SYMMTX(A6) ♦HlGH(fiO) »C0N(60)  ^ 
,FLnKEY.NOELO2»NOFLD3»NOFET?.EETVC2(30) 
♦N0SUH2,N0TRF0*T0TVT|»N0CLS| 

,KATNO(Sn) .NOCATtFILTER.MAPFMT  „ „ 

» DES^EY. DESUN  I tDESOTH. CROP  , ACROP»AgTHFR«ATOTAL 
♦SITE (6) ♦ANALYSIS) ♦CAM (IS) ♦CRPKEY^KEPPTS (60) 
♦DOTKEY^DOTERR 

DIMENSION  TAPLF(60^61) 

DATA  THR/'THRE'/ 

SUPNAM (NOSUBI)  2 THP 
CLSNAM (N0CL52»1 ) s IHR 
CATNAM(NDCAT*1)=TMH 
IFIPCFDKY.nf.  UGO  TO  PI 
CLASSIFICATION  SUMMARIES  BY  FIELD 

SUBCLASS  performance 

TR=1 

IF*1A 

IE(IF.r,T.N0SUB3)  1E  = N0SUH3 
WRITF(B.HF4n) 

TEdSIXEY.l-.  -’.  1 ) WHITE  (6^  100) 

IE ( TSTKE Y.NF. 1 ) WHT TE ( 6^200) 

IE  (FLOKEY.F'''.  1 (WRITE  (B^  350) 

IE (FLDKFY .NF . 1 ) WHITE (&♦ 351 ) 

WRITE  (B,  300)  (‘^UBNAM(I)  ♦I  = IB^IE) 

WHITE (B. 3sl ) 

PCTT=n,0 
DO  ?0  Jsl,NOFLO 
ISsFLDSAV (3^.n 
TC=FL0SA7(2.J) 

IF  ( J5.MF .0) namf=SUHNAM( IS) 

IF  ( IS.F'.'.OI  NAMF  = CLSNAM(  IC) 

T0TSAM( j) =0 

DO  10  K=1.N0SU“3 

TOTSAH(J)  = TOTSAM(J)  * PCTAB(J^K) 

IF  (FLD^FY.Nf:.  1 ) GO  TO  15 

PC T=Fl DAT (POTAP ( IS) ) /FLOAT (TOTSAMIJ) ) •100, 
pCtTsPCTT ♦PCT 

WHITF(b,AOO)  FLOSAV(l^J) ♦NAMF^TOTSAM ( J) ♦PCT^ (PCT  AB(J^K)^KslR,IF) 

WRITE (B?t 00)  FLOSAV 1 1 ♦ J) ♦NAME ♦TOTS AM (J) ♦(PCTAB(J^K)^K«IB^IE) 

FONT  INIIF 

IE(IF.FO,nOSUU3)GO  TO  30 

IP=IF»1 

IF=IF*l4 

PCTT=0.0 

r,o  TO  5 

rONT INUP 

PCTTsPCTT/NOFLO 


PRTOOOIO 

PRT00020 

PRT00030 

PRTOOOAO 

PHT00050 

PRT00060 

PHTOOO70 

PRT00080 

PRT00090 

PRTOOlOO 

PRTOOllO 

PRT00120 

PRT00130 

PRTOOlAO 

PRT00150 

PRT00160 

PRT00170 

PRTOOIBO 

PRT00190 

PRT00200 

PRT00210 

PRT00220 

PRT00230 

PHT00240 

PRT00250 

PRT00260 

PRT00270 

PRT002BO 

PRT00290 

PRT00300 

PRT00310 

PRT00320 

PRT00330 

PRT00340 

PHT00350 

PRT00360 

PHT00370 

PRT00380 

PRT00390 

PRT00400 

PPT00410 

PRT00420 

PRT00430 

PRT00440 

PRTOOA50 

PRT00460 

PHT00470 

PRT004B0 

PRT00490 

PRT00500 

PRTOOSIO 

PRT00520 

PRT00530 

PHT00540 

PRT00550 

PRT00560 

PHT00570 

PHT005B0 

PHT00590 

PHT00600 

PRT00610 

PRT00620 

PRT00630 

PRTOC640 

PHT00650 

PRT00660 

PHTOO670 

PHTOO&BO 

PRTO0B90 

PRT00700 

PRT00710 

PRT00720 

PRT00730 

PHT00740 

PHTO07S0 

PHT007B0 

PHT00770 

PHT007B0 

PRT00790 


ohrun^al  page  18 

OF  i^jjaliTY 


FILE  I PRTFCT 


IF (FL0KEY.E0.il  WRITE <«»860»PCTT 
PCTT-0.0 


PCTT-0 
t8>i 

NOW  field 

IN  > NOSUI 
IF(|E,  ■ 
WRITE 
IF(tsT 


CLASS 


IN  ■ NOSUB2»l 

IF ( IE .OT.NOCLSZ* I ) 1E-N0CLS2* 1 


WRITE! 

IF(TSTk 

!F(TSTK 


(6.HEAn> 

KEY.NE.liWRITE(A(6QQ) 

KEV.E0.i)WRITE(6«6S0) 


WRITE(6*3S1 I 

WRITE (A. 300) (CLSNAM(I) .I-IRtlE) 
WRITE(6.3S1) 

00  50  J»I»NOFLO 

condense  a line 

00  33  K«I,IN 
33  RUE(K)«0 

no  3S  Kal.NOSURE 
1K*CLSSUR(K» 

3R  PUE{IK)s  BUEUK)  ♦ PCTAR(J.K) 
IC»ELnSAV(?,J) 

BUF(NOCLS2*l)  =PCTaB(J.NOSUB3) 

PCT  » El.OAT(PUEnCI)/FLOAT(TOTSAM(J)) 


PCTT=PCTT*PCT 

WRITE(6.AOO) 


FLOSAV(l.J) .CLSNAM(IC) .TOTSAM(J) *PCT» 
(b>UF(K)  .KsIBtlE) 


SO  continue 

IF(IF.F0,N0CLS?*1)60  TO  60 

IB=IF.l 

IF=IF*U 

PCTTsO.O 

r,0  TO  3? 

6ft  CONTINUE 

PCTTsPCTT/NOELO 

WRITE(6.H60)PCTT 

PCTT=0.0 

NOW  EIELO  by  CATEGORY 

tf(catfl6.eo.o)go  to  R1 

TP=l 

IE=IE*1* 

62  IF  (IE.GT,N0CAT»1) IEsNOCAT  ♦ I 

WPITE(6.HEA0) 

IF(T5TKEY.NP,1)WRTTE(6.700) 

. !F(TSTKEY.F'0.1)WRITE(6.750» 

WRITE(6.35?) (CATNAM(I).I=IR.IE) 

WRITE (6,151 1 
no  7ft  Jal.NOFLO 
no  63  Kal.IN 

63  PUF(K)aO 

no  66  Ksl.NOSUP? 

TK  = SIJBCAT(K) 

6S  RUF(IK)  5 mJE(IK)  ♦ PCTArt(J.K) 

IC=Fl.nSAV(^.J) 

tC*T=KATNO(TC) 

PCT  = ELHAT (bUE( ICAT)> /FL0AT(T0TSAM(J) ) • 100. 
PCTT=PCTT  .PCT 

RU^(N0CAT*1)  = PCTAB(J,nOSUB3)  , 

WPTTF.  (6.400)  ELOSAV(  1 . J)  .CATNAM  ( ICAT  ) .TOTSAM(J)  »PCT. 
• (PUE (6) ,K=IM. IE) 

7ft  CONTINUE 

IF(IE.F0.N0CAT*1)G0  TO  PO 

TRsIE.l 

IE=IF*14 

PCTTsO.O 

GO  TO  6? 

Pft  CONTINUE 

PCTT=PCTT/NOELn 
WRITE (6,«6ftlPCTT 

NOW  COMpRESG  PCTAB  TO  CLASS  BY  SUBCLASS 


7EP0  TABLE 
CONTINUE 

no  AS  1 = 1.(40CLS? 
TOTSAP( I ) =0 
no  Js1,nOSUB3 
TABLE(I.J)=0 


PRT008 

PRTOOJ 


PRTOOSAO 

PRTOOPSO 

PRT00860 

PRT008R0 

PRT0O900 

PPTOOOlO 

PRT0Q9|0 

PHT00930 

PRT00940 

PRT00950 

PRT00960 

PHT00970 

PRT00980 

PRT00990 

PRTOIOOO 

PRTOlOlO 

PRT01020 

PRTOl030 

PRT01040 

PRT01050 


PRT01070 

PRTOIOBO 

PRT01090 

PRTOnOQ 


PRT0II20 

PRT01130 

PRT01140 

PRTOnSO 

PRTOlUo 

PHT0il70 

PRTOnRO 

PRT0ll90 

PRTOiZOO 

PRT01210 

PHT01220 

PRT01230 

PRT01240 

PRT01250 

PRT01260 

PRT01270 

PRT01280 

PRT01290 

PRT01300 

PHT01310 

PRT01320 

PRT01330 

PRT01340 

PRT01350 

PRT01360 

PPT01370 

PWT0J3A0 

PWT01390 

PRT01400 

PRT01410 

PRT01420 

PPT01430 

PRT01440 

PRTOUSO 

PRT01460 

PRT01470 

PKT0I4A0 

PRT01490 

PRT01500 

PRToIblO 

PRT01520 

PRT01530 

PRT01540 

PRT01550 

PRT01560 

PRT('1570 

pmoibso 


FIUFI  PRTFCT 


no  90  i>i«NOrLO 


c* 


OO 


rONT|NUE 


91 


9? 


C* 


97 


94 

95 
9.-H 


9A 


r* 

€♦ 

c* 


•4**  i«» 


BY  SUBCLASS 


r«iA 


112 


FltF.6T.N0SUB3) IE>N0SUB3 
WRITE  *01 

- - " “ITE(6»«00I 

ITEiOtasn 
AH(I)  tlBlflt 


■ lit  •1^1 

JFlfSIKFY.NF.ni^P 


rFtTSTKEY.kO.DWH. . 
WR1TE(F.tAlO)  (SUBNAH 


WRtTFI6.3Sn 
??<tM*mU>  iki?0>60  TO 


IE) 


WRTTF  (fi*820)CLSNAM(I)  »TO 
rONTlNUF 
1B>1H*14 


i?SAM(l)*(TABLEn*U)*J«lB*lCI 


NOSUB3)60  TO  91 


CLASS  BY  CLASS 


« TABLEdfJ) 


00  93  1«)»N0CLS2 
00  97  J«lfN0CLS2 
BUF(J»«n 

no  94  Jr1.N0SUB2 
IC«CI.SSUB«J)  ^ 

ByF<!C)=8UF(TC) 

DO  99  J»1.N0CLS2 
TARLFdfJ)  aBUF<J) 

TABLE ( 1 .NOCLS?*! ) «TABLE ( I .N0SUB3) 

rONTiNUE 

«»CTT«0 

IB»1 

IE«14 

!F(|F.GT.NOaS?*l)  1E«N0CLS2*1 
WPtTecs.HEAf)) 

IF ( TSTkey. eo.n  WRITE  C4.B30) 

IF ( TSTKEY.NF. 1) WRITE 835) 
WRITF<4,810» (CLSNAM( I) • IsIBtlE) 
WRITE(6.351) 

NCeft 

DO  107  I«l.NorL52 
IF(T0T9«H(n  .EO.OGO  TO  107 
MC=NC*1 


PCT* (FLOAT (TABLE ( I ♦ I ) ) /FLOAT ( TOTSAM (I ) ) ) *100. 
PCTTsPfTT  ♦ PCT 


107 


WBITF(8,fi50)CLSNAM(I) , TOTSAH ( 1 ) tPCT * (TABLE ( It J) tJsIBtlE) 
CONTIMJF 


lAB 


IF(1F.E(J.N0CLS2*1)60  TO  lOB 

IB»IBtl4 

lEsIF.M* 

PCTT=0.0 
GO  TO  96 
rOWTINHF 
PCTTxPCTT/NC 
WRITF(6,860)  Pf.TT 


NOW  CLASS  flV  category 


11* 

IIB 

llA 


117 


IF(CATFLG.ED.fli)RETUHN 
00  116  J-1.N0CLS2 
r>0  112  Isl.lOCAT 
nUF(l»Bfi 

no  114  ^»l.NO^.Ls? 

ICsFATNO(K) 

RIJF(IC)=HJF(!C)  ♦ TABLEil.KI 
no  115  KjI  ,V0CM 
TABLP(J.K)*  MUF(K) 

TARLFf J»60C AT* n stable <J»N0CLS2*1) 

roNTI^'!;F 

PCTTsO.O 

IR*1 

(Es]4 

IF<fF,GT,iMOCAT*l»  1E*N0CAT*1 
WPITF (6.HEA0) 


01590 


PRTO 
PRTO, 
PNTOlB 
PRTO*“ 
PRTO 
PRTO 
PRTO 
PRTO 


6B0 


PRT01690 

OOTAt  ORA 


PRTO 

PRTO 

PRTO 

PRTO 

PRTO 

PRTO 


PRT0I960 

PHT0197O 


PRT01980 


PRT01990 

PMT02000 


PRT02010 

PRT02020 

PRT02030 

PRT02040 

PRT02050 

PRT02060 

PRT02070 

PRT02080 

PRT02090 

PPTOllOO 

PRTOlllO 

PRT02120 

PRT02130 

PRT02140 

PRT02150 

PRT02160 

PRT02170 

PPT021B0 

PRT02190 

PRT02200 

PRT02210 

PRT02220 

PRT02230 

PRT02240 

PRT022S0 

PPT02260 

PRT02270 

PRT022B0 

PWT022R0 

PRTO/300 

PPT02310 

PPT02320 

PRT02330 

PRT02340 

PRT02350 

PRT02300 

PRT02370 


n/:/f 
VI-  Ih ,, 


riLEJ  «»TPCT 


EQ,i)WFtn£(A»|70} 
N£.1)**RITc  J6»S75i 
0) (CATNAHC J> 


>IC) 


lie 


119 

10ft 

20ft 

3ft0 


ir(T«iTK|V.E2» 

If  (T**TkCY,N£ 

aiU!J;5lS! 

?Ji?jTsiJlil?S<s5Sl«0  TO  110 

NC«NC*1 

Mt5moH(T«l.eiI.lCll/rL0AT(t0T5»H(Illl»10«. 

5Sl??^SlU;.cEWll>.T0tS.H.I1.0CT.(t.ei.t(I.Jl.J-t».K' 
??7if^0E»N0CAT*1 160  TO  110 

ACTT»OoO. 

GO  TO  11? 

CONTINUE,  „ 

?CTT»PCfT/NC  ,,, 

w6nF<ft»fl«>o)f;cn 


''•'CR  If 

'■i^'AUry 

PRT0235$ 

PRTt?390 

PRTO£*ftO 

PRTtfgAiO 

PRTO?%25 

PP1O2<i30 

PPT02*5P 

j»RT02*5p 

ES??|i!S 

PRTOJ 
PRTOi 
PPTO’ 
PRTOL. 
PRT02'  - 

ESnilr. 

PRT02550 
PRT02560 
— Zili 


"iiHiisl-ifrshlflESllSS 

FftOMAT</)  .c.  To-o.  oTnT«i  0 .T24o»PCT.*/._  . 


3^1 

3S2 


«A6>/) 


format ili 0 'riFLO*.!!?. 'TOTAL* oT24^*^^^ 


soft 

AftO 

A«10 

TftO 

7^ft 

HOft 

Alft 


HRft 

ATS 

010 

RRl 

BAO 

B70 

871 


5'2**F?;?!|* 


1A(I5*2X)> 

X)  ) 

TP^INING 


■ if !f iJiSK'IXSSiS;’ : ??H"frEtEi'k9'cKs|9r" 


CATEOORY' 


•PCT.'/ 

•'  Tx.ona*  ^ 

310  FOPMM  f i',****''’!’ 

4A0  FOPMi-  ’ j*-  '*' 

fflR*  ''  nXoJ.Ao_.TXo 

FOX"  nift? 
n ox 

CrtPMO  ' (iOX»->,w---.- 
FOP"* ‘ ( 1 OX  0 'CLASS IF 
FO»''f<10Xo«  CLASSY 
format  «/\ ox. 'TOTAL 
• ,iX,1-o!3X.A4)^/) 

B?0  forma 
for*''' 

SUBCLASS') 

iBrsiiishiEtuiiEiir?® 

return 

fcNO 


EEUilil 

PRT02590 
IPRTO 
PRTO 
PRTO 
PRTO 
PRTO 
PRTO 

PRTOv-s" 

PRT02670 
PRT02680 
PRT02690 
PRT02700 
)PRT02710 
PRT02720 
PHT02730 
Pf  T02740 
PRT027SO 


>MAi  nxoAAo 3Xo iSo isxo |4 nso2x^^  _ test  cla' 

E S iSS  |U«t  . 


;lass  by 

■ - CLASS 


"M'IEUsm 


PRT02760 
PHT02770 
PRT02780 
PHT02790 
PRT02800 
PRToaeio 
PRT02620 
PHT02B30 
PRT02B40 
PRT 02650 


SJi, 


‘ILft  PRTSUM 


r 

c 


UAROUT  t ME  PRTSUM ( TOT AUS  « TTOL  t FLOCSC ) 


RStKg;  I’ss&itm] 

O**MON/(H.O0At./HCAO  I 


CO**MON/(H.O0At./HI 
HI 

ORUHAOtORMwi 
• NHSTUN.NMJTF.  . . 
.nOTUNT.OOTFIL»N- 
roi,\iNT*t»RTUNT.WANOI 
CC'-!HON/OISPL/CATKLfi«C 

SUnCATlAfl)  • 
PCFOKY.TSTK 


a«PA6SlZ*nATFtLt$tAFfl.*ASAV*ASAVFL 
t^CTRON»MAPFll. 

MPAS*  TPNSFL  « BMTPFL • H I STFL  * PCHWlT  « 


ATNAM|Mi«CLSNAM|6^»  ^SgBNA*4^|)  *SU0NO(6O) » 


OltNOMI  . 
Y«TmRS?Y| 


n*su 

mi 


»»CFn»«T«TSIRtT»  IMWtT*  I f1K5« T » » I ■ IHT *€MPtfiS* TM0SVA* 

* - 


TMHFSi 

.floke 

,NOSUR2 

*KATHO< 


CSCNO 


.ntSKEY.ncsuNi.nESO 
.STTF  <(S»  tANALYS«SI  t 
•nOTFCYtOOTERR 


..  .CPW*  .ACRQPtAOTMFPfATOTAL 
CAMTISI .CBPKCY*KepPTS«60) 


C» 

c« 


niMFNSTON  T0TALS<66>*TT0U6«» 

INTFGFP  6.  CPPTYP.F*M.Z*Y 

IntIgIp  T I?Llsuil§AfFL6.SU0CAT 

integer  C«PKEY*CWOPtCATNAM,CLSNAM,SU0NAM 


IF  intensive  test  site 

match  on  'CROP*  NAME. 

CRPTYPcO 
1F(chpkey.ne.1)go  to  iO 

00  3 I*l»NOrAT 

IF(CRUP.E0«CATNAM(I)IG0  to  0 

? continue 

no  3 I«1*N0CLS2  . « , 

IFrCROP.EO.CLSNAM(I) )G0  TO  7 
3 CONTINUE 

no  A 1ti,nosuh2 

!F(CRnp.EO,SUBNAM(I))GO  TO  0 
A CONTINUE 

WRITE {A.4?01CROP 
400  FORMAT <• 

•UBCl.ASS  NAME. 

•OINTEHM 
CRPKrYaO 
GO  TO  10 


summary  report  is  to  be  printed*  find  a 


OR 


THE  CROP  Name  '.aa**  does  not  match  a CATEOORY.CLASS 
amE'/‘  The  intensive  test  site  SWMARY  ReWrT  CANNOT  BE 


€• 

C* 

CROP 

IS 

A 

CATEGORY 

C.^ 

CPnP 

IS 

A 

CLASS 

C* 

CROP 

IS 

A 

SUBCLASS 

C* 

CRPTYP>1 

CRPTYP«2 

CHPTYP>3 


C* 

C* 

C* 


10 


?0 


INnEXxI 
CpPTYpBl 
GO  TO  10 
INnEX=I 
CPPTYPsp 
GO  TO  10 
iNOEXsI 
CHPTYMsI 
CONTINUE 
GsO 
H«fl 
1 1>0 
J1*0 
JJ»0 
OO  i?" 


6A 

n 


♦ jj 


JJmTOTAL< 

PRINT  CI.ASSIFICATION  SUMMARY  FOR  THIS  FIELD 

CALL  SETmhG(AB.A,62I 
WHITE(G. HEATH 
WOl TE (Gt?60)FLOf GC. JJ 
J«  JJ  - fOlALStOfSLNlI 
FT  « TOTALS«nESUNI) 

IF(J  ,LT.  JJ)wH1U:(6.26S» 

MT«T0TALS  <0ES0TMI 


KT.  J 


PRTOOOtO 

PRTOOOlO 

isisisl; 

PRTOOOSO 

PRT00060 

PRTOOOTO 

prtoIEr^ 

PRTOOlOO 

PRTOOnO 

PRTOOflO 

PRTOOpO 

PRTOOlAO 

PRTOOIRC 

PRT00200 

PRI00220 

PRT00230 

PPTOOZAO 

PRT002S0 

PRT002A0 

PRT00270 

prtoo|ao 

PRT002RO 

PRT00300 

PRT00330 

PRT003A0 

PRT00350 

PRT00360 

PRT00370 

PRT003B0 

PHT00390 

PRTOOAOO 

PRTOOAIO 

PRT00A20 

PRT00A30 

SPRTOOAAO 

PPRTOOASO 

PRTOOAAO 

PRTOOA70 

PRTOOAAO 

PRTOOAOO 

PRT00500 

PRTOOSIO 

PRT00S20 

PMT00S30 

PRTOOSAO 

PRT00S50 

MRT00S6O 

PRT00S70 

PRTOOSAO 

PRTOOSRO 

PRT00600 

PRTOOGIO 

PRTOOt20 

PRT00630 

PRT006A0 

PRT006S0 

PRT006N0 

MHT00h70 

PRT00680 

PRT00N90 

PPT00700 

PRT00710 

PPT00720 

PRT9C730 

PRT0O7A0 

PRT007«iO 

PMT007AQ 

PRT00770 

PRTn07A0 

PRT00790 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


riLFJ  PRTSUM 


290 


29S 


l\l 

3?0 


3»3 

3»S 


3>A 

3?<i 

330 


WR 

MR 

«iR 

no 


»MT.GT. 

TF(0 
T^(6 
T£<A. 

tf2?of; 

TUFI.O*.  . 

•totals < I 

IT«TOTALS( 
PC*PT/i^LiAT(!TTL 
ptIpt*fl6aT(j?*i 


HRITC(6t266MT 


<mu;] 

<U  ' pi 


XAf 


■ f’A(;r  rs 

QrAiiiY 


1«N0SUR2 
,^S{J|*T?OL 


1!. 


m 


<JI*100. 


D/FL 

)/FLOATU)*100. 
AT(!TTU*100, 

no 


wR!TF{#»»2P01SURNAM(1) .ITTL»PCTT»lTtPlTtPPIT»TTOL (I) *PT*PC 
1F«C»PTYP.NF,3)60  to  290 

th!NnFA.eu.!)60  TO  so 


h*TTTL 


J1«J1*!T 
RO  TO  ?90 
G«G*ITk 


rwUmr 

ppfTT«T0TALS(N0SUH3J/F 

WRITFlO.aRS) JTTL.TTOL(NOSUB3) 


. TT0l(N0SU 
/FLOAT (J> 


TlMe.i 
TC*NOfLS2 
rONTtWiF 


SVS|1 

tKTTLt 


PPCTT 


- t|n  . 

WRITE (AfHEAO) 
WRITF  «ft»260lF 
T,JJ)W^ 


IF(J. 

HT«TO 


TAI. 


^^FSC.JU 


TFJMT.RT.  . 
wfiITF«A,?70» 


S«nfSOTM) 
0)k>WITF(0*266) 


6«26S>KT«J 
MT 


IF(TI^F.E<i.nwnnF(6» 
lFaP«F.^),?>wKlTF<6 


:l2tl 


li' 


WRITF(*^.?«0) 

WR1  rr  (#.,276) 

OO  330  IJ-I.IC 
IT*n 
TT*0 
TTL«0 

jO  3?n  i»it*J05yf<g 
IF(T!vF.EA.nr)0  TO  _ 
lF(«.UHr*T»  I)  ,NF.U)6 
so  T031F 

IF (CLSSUM < n .NF.IJJGO 
IT«TOT/>LS(l)*lf 
ITTL»TTOl.  ( n ♦TOTALS  m *ITTL 
ITT  = TTOLm»ITT 
'O^T  I^'OF 

»CTT=Fl  rial  (ITU) /FLOAT  IJ)  •100. 
»lTsn.OaT  ( m /float  (J)  *100. 
!*T*rL(iAT(nT) /FLOAT  (J>  •100. 
PPTTsFlOAT (IT) /FLOA7(ITTL»*100. 


TO  320 
TO  320 


CeinO.-PPlT 
F»T-  - - - 


(R)  TP  (*••?•<  0)CLSUAM(  IJ)  «ITTLiPCTT»1T»PIT»PPIT»|TT»PT.PC 

'F(rRPTYP.NF.2)00  TO  329 

JFdN'lFx.FO.I  JXjO  TO  323 

MxH*!TTL 

J1*J1»IT 

fiO  TO  326 

OxO.ITTL 

Tl«lj^*IT^ 

*^WRI  TF  (9^2*41)  CATNAM(  IJ)  . ITTLtPCTT.1T  .PIT.PPIT.ITT.PT .PC 
IF(f*iMTYP,N‘‘.  1 M»U  TO  326 
lF(l»JOFi.Fi).IJ)GO  TO  324 
H«Mt ITT* 

Jl»Jl*iT 
r,0  TO  326 
R»R.  ITTL 
n.n»iT 
fOF'TimjF 
COTjT  !)4(JF 

WRITF  (A.'/MS)  JTTL.TT0L(N0SUP3)  .KTTL.PPCTT 


PRTOOSOO 
PHTOOSIO 
PRT0Qi2C 
PRT( 

PRT< 

PRT(  . 
PRTOOl 
PRTT 
PRT( 

PRT(  . 
PRT009C 
PRT0091 
PBT00920 
PRT00930 
PRT00940 
PRT00950 
PRT00960 
PMT00970 
)9R0 
1990 
11000 


PRTO? 
PRTf 

PRT( 
PRTO] 
PRTOi 
PRJ 
PR1 
PRTOl 
PHT01060 


I V 

!«_. 

JTOIO'O 


PRTO 

PRTO 


070 

090 


PRT01090 


ii 


PRTO 
PRTO 
PRTO, 
PRTOl 
PRTOl 
PRTOl 
PHTOi 
PRTOi 
PRTOl 
PRTOl 
PRTOl 
PRT01210 
PRT01220 
PRT01230 
PRT01240 
PRT012S0 
PRT01260 
PRT01270 
PRT01280 
PRT01290 
PRT01300 
PRT01310 
PPT01320 
PRT01330 
PRT01340 
PRT013S0 
PRT01360 
PRTOl 370 
PRT01390 
PRTO13P0 
PRT01400 
PRT01410 
PPT01420 
PWT01430 
PRT01440 
PHTOI ASO 
PRTOl  A(S0 
PhToIaTO 
prtoUho 

PPT01490 

PRTOJSOO 

PHTOISIO 

PPTOlbPO 

PHT01S30 

PPTOlbAO 

PPTOISSO 

PBT01b60 

PHT01S70 

PPIOISSO 


riLFt  PRTSUM 


IF{T1ME.EQ.2)60  to  340 
TF<C4TFLG.E«.0)60  TO  340 
1C»N0CAT 
TIMFa? 

GO  to  295 
340  CONTINUE 

IF  (C9PKEY .NE. 1 » RETURN 
WRITE(6.SOO)CROP.SITE*ANALYS 
WR1TE(4»505)  CAM 
Oa  ACWOP/ATOTAL 
Fa  aothem/atotal 

WRITF(4.S10tCR0PtACR0P»CR0P*0*  AOTHERtE*  ATOTAL 
HaH>TOTALS(nESOTH) 

JlaJl ♦TOTALS (OESOTH) 

7aTOTALS(DESUNI) 

YaJJ 
FaY-7 

WRITE(6,52U)  Y»Z.F,CROP»G»H.CROPtIl»Jl 

KrO-Ii 
LaH-Jl 
MaK^L 

WRTTF (4.530)C«OP»K»L»M 
RNaFLOAT(K>/FLOAT<G) 

0 sFLOAT <U /FLOAT (H) 

P rFLOAT(K)/FLOAT(F) 

Q =FLOAT(L)/FLOAT(F) 

WRTTF (4,540) CR0P»«N,0»CR0P»P.0 
P=FLOAT(K^L) /FLOAT <F) 

SaFLOAT(G)/FLOAT(F) 

TsFLOaT<H)/FLOAT(F) 
llaFLOAK  ID /FLOAT(F) 

VaFLOAT(JD/FLOAT(F) 

WrFLOAT (H^K) /FLOAT (F) 

WRTTF (4,550)R,CROP,StT»CROP.U,V»N 
WRTTF(4,610) 

WRTTF 

WRTTF (6,560) 

WRTTF (6,575) 

WRTTF (6,570) 

WRTTF (6,5P0) 

WRTTF (6,S7D) 

WRTTF (6,5«5) 

WRTTF (6,570) 

WRITE (6,590) 

WRTTF (6,570) 

WRTTF (6,560) 

WRTTF  (6, 5^*5) 

WRTTF (6,570) 
wRITF (6.611 ) 

WRTTF (6,570) 

Tl=5-n 
T?=U-0 
WRTTF (6,600) 

WRTTf"  (6.570) 

WRTTF (6,560) 

WRTTF(6.605) 

WRTTF (6,570) 

WRTTF (6,615) 

WRTTF.  (6.570) 

OATA  NAME  /»CROP»/ 

T1=T-F 

T?aW-E 

KHrH^K 

WRITE  (6.6'lO)N4W(r,H,T,Tl,KH»W,(J,T2 
WRTTF (6,570) 

WRTTF (6,5701 
WRITF (6,560) 

?60  FORMAT (/•  CLASSIFICATION  SUMMARY  FOR  FIELD  *tA6// 

« • TOTAL  N(iM5ER  OF  SaMPLFO  POINTS  •«I10) 

265  FOPMATC  less  OESIGNATEU  UNIDENTIFIABLE  • ♦ II 0/T36, 7 ( •- • ) / 

?66*F0OMAT  (//•*  'JO.  OF  PIXELS  OESIGNATED  OTHER*  ,T33,T  10//)  . ,,, 

500  F0RMAT(1H1,T6*,*INTEnSIVE  TEST  SITE  SUMMARY  (SePOHT  FOR  *,A4  /// 

• T?0,*N4»Jf  OF  INTENSIVE  TFST  SITE  • ,6A4»T71 » ‘NAME  OF  ANALYST  *, 

• 5A4/T4A,2?( '-' ) ,T86,  IR ( •-•  ) ) 

c;n5  FORMAT  (T?f>, 'PROCtriUME  CONFIGURATION*  ,T4R  , l5A4/T4fltS6  (*-*)/ ) 

510  format (T IS, 'GROUMn  TRUTH  FOR  INTENSIVE  TEST  SITE*  /T15,36( *- * )/ 

• T?0,*ACRFAOF  OF  *,A4,  * A s *,F6.1«T62  , 

• tTRUF  PROPORTION  IN  *,A4,5X,*A/C  a 0 = *»F4.3  / 


CR0P,G,S,T1,I1 ,U,PtT2 


PRTT)1590 
PRT01600 
PPT01610 
PRT01620 
PRT01630 
PRT01640 
PRT01650 
PRT01660 
PRT01670 
PRT016B0 
PRT01690 
PRT01700 
PRT01710 
PRT01720 
PRT01730 
PRT01740 
PRT01750 
PRT01760 
PRT01770 
PRT01780 
PRT0i790 
PRT018CO 
PRTOieiO 
PRT01B20 
PRT01830 
PRT0184O 
PRT01850 
PRT01860 
PRT01870 
PRT01880 
PRT01890 
PRT01900 
PRT01910 
PRT01920 
PHT01930 
PRT01940 
PRT01950 
PRT01960 
PRT01970 
PRT01980 
PRT01990 
PRT02000 
PPT02010 
PHT02020 
PRT02030 
PRT02040 
PRT02050 
PRT02060 
PRT02070 
PRT02080 
PRT02090 
PRT02100 
PRT02110 
PRT02120 
PRT02130 
PRT02140 
PRT02150 
PRT02160 
PRT02170 
PRT02180 
PPT02190 
PKT02200 
PRT02210 
PHT02220 
PRT02230 
PPT022A0 
PRT02250 
PRT02260 
PRT02270 
PHT022RO 
PHT02290 
PRTO2300 
PRT02310 
PHT 02320 
PRT02330 
PRT02340 
PRT02350 
PRT02360 
PPT02370 


FlLFt  PRTSUM 


I 

i 


t 

E. 

f 


f 

f 


f 


[ 

L 


Ob' 


Pi 


iv 

- QiP 


B = »t  F6.1«T62  f 


• T?0.*AC«FAr,E  OF  OTHER 

• »TRUE  proportion  in  0THERt,4x,iR/C  « E 

• T?0, 'TOTAL  ACREA6E'tT39*»C  = 'tF6.^///) 


5?0  FOBMATITIS. 'RESULTS  OF  COMPUTATION  FOR 


• T15.A6C-')/ 

• T?n» 'TOTAL  NUMBER 
T?0» 'TOTAL  NO.  OF 

'Z='«I6  / 

T?0» 'Total  number 
'Y-Z=F=».I6/ 

T?0. 'NUMBER  Of  PIXELS 
TR6.'0='*I6 
T?0. 'NUMBER 
TQS.  'Hs'  . Ifj 
T?0.  'NUMHE-R 
T06.'I='»I#. 

T?0. 'NUMBER 
TB6.'J='.IS 


*.F4,3  /• 

INTENSIVE  TEST  SITE*/ 


PRT02380 

PPT02390 

PRT02400 

PRT02410 

PRT02420 

PRT02430 


OF  PIXELS  IN  INTENSIVE  TEST  SITE • .TV6. • Y=» . 16/ 

PIXELS  IN  EXCLUSION  (UNIDENTIFIABLE)  AREA* .T96.PRT02440 

PRT024S0 

PIXELS  IN  EXCLUSION  AREA*  .T92» 


/ 

OF 

/ 

OF 

/ 

OF 

> 


OF  PIXELS  LESS 
CLASSIFIED 
CLASSIFIED 
CLASSIFIED 
CLASSIFIED 


PIXELS 

PIXELS 

PIXELS 


AS 

AS 

AS 

AS 


*.A4.*  BEFORE  thresholding*. 
OTHER  BEFORE  THRESHOLDING*. 
*.A4,*  after  THRESHOLDING*. 
OTHER  after  THRESHOLDING*. 


PRT02460 
PRT02470 
PRT02480 
PRT02490 
PRT02500 
PRT02510 
PRT02520 
PBT02530 
PRT02S40 
PRT02550 

S30  FORMAT(T?0. 'NUMBER  OF  PIXELS  CLASSIFIED  AS  *.A4.*  WHICH  WERE  THRESPRT02560 
*H0LDEn'.r»?,*fi-I=K=*,I6  / PRT02570 

* T?0. 'NUMBER  OF  PIXELS  CLASSIFIED  AS  OTHER  WHICH  WERE  THRESHOLOED'PRTOZSfiO 

*»TB?. 'H-J=L=* . 16  / PRT02590 

* T?0. 'TOTAL  NUMBER  OF  PIXELS  THRESHOLDEO* .T92. *K.L=M=* . 16)  PRT02600 

540  FOdmaT (T20. 'PROPORTION  OF  *.A4.'  PIXELS  THPESHOLQEO* »T92. *K/G=N=* .PRT02610 

* F6.3  /T?n, 'PROPORTION  OF  OTHER  PIXELS  THRESHOLDED* . T92. *L/HsO=* . PRT02620 

* FA. 3 /T?0,'PRnPOPTI0N  OF  ».A4.'  PIXELS  THRESHOLDEO  (OF  THE  TEST  SPRT02630 

•IT*^)'.  TB?. 'W/F=R=i  ,FA.3  / PRT02640 

* T?n, 'PROPORTION  OF  OTHER  PIXELS  THRESHOLDEO  (OF  THE  TEST  SITE) '.PRT02650 


PRT02660 

PIXELS  THRESHOLDED'.TBB.' (K*L)/F=R=',  PRT02670 
'♦A4.'  BEFORE  THRESHOLDING*. T92. 'G/F=Ss*PRT02680 
OTHER  BEFORE  THRESHOLDING*.  T92. 'H/F=Ts.PRT02690 
»,A4.'  AFTER  THRESHOLDING',  T92, • I/F=U**PRT02700 


* T92.'L/F=0=',F6.3  ) 

550  FORMAT (T20. 'PROPORT  ION  OF 

* FA. 3 /T20, 'PROPORTION  OF 
*.FA,3  /T20. 'PROPORTION  OF 
*.FA.3  /T21, 'PROPORT ION  OF 
«,FA.3  /T20, 'PROPORTION  OF 
*.FA.3  /r20, 'PROPORTION  OF 

* • (G  + K) /F  = «=* . F6.3  ) 

5A0  FORMAT (TIO. 101 {*-' ) ) 

570  FOOMAT  nH.,T10,*-'.Tl9. *-* .T31 » ,T42. *■ 

« , TR4, '-' .Til  0. *-' ) 

575  FOOMAT (T44, irOMPUTEO* ,T96. 'COMPUTED' ) 

5B0  FORMAT (T33, 'PPOPOR. ' »T44, 'PHOPOR.  LESS* .T59. 'NO.  OF 

* 'PHOPOR.*.  TBA.'PROPOR.  LESS'  ) 

585  FOOMAT (T21,'MUMRER'.T33.*REF0HF».T44. 'TRUE  PROPOR.'.  - ^ 

* TLSFY.  AKTFRt ,T74. 'AFTER* . T84 .' PROPOR . T96.*TRUE  PROPOR.') 

5Q0  FORMAT (T 12, 'CROP' ,T21, 'OF  PIXELS* ,T33. 'ThRSH. * , T44. 

» .oprORF  THRSH.',  T5R, 'THRESHOLD' , T74, • THRSH. • . T84. 'THRSH. • .T96.PRT02830 

* iaFTfh  THRSH.')  PRT02B40 

595  format (T?5, • (G) • , T35, ' (S) • ,T47, • (S-0) • . T62,*(I)*. 


OTHER  AFTER  THRESHOLDING'. 

PIXELS  TO  BE  CONSIDERED  AS  OTHER'.TeS. 


■•,T57,'-'.T72.*-*,T82, 


T92,  *J/F=Vs'PRT02710 
- PRT02720 

PRT02730 
PRT02740 
PRT02750 
PRT02760 
PRT02770 
PRT02780 
PRT02790 
PRT02P00 
PRT02810 
PRT02820 


PX.'.T74. 
T59. 


♦ T7A,'(U)*  ,TP6, • (P) * ,T99, ' (U-D) * ) 

600  FORMAT (T1?,54,T23,I6»T33,F6.3,  T46.F6.3. 
T9a.FA.3  ) 


605  format (T2S, * (H) • . T3S, ' (T ) ' ,T47. ' (T-F) ' , T61,*(H.K)*. 

« T7A,'(w)*,  T86,'(Q)'.  T99,*(W-E)'  ) 

610  FOP”aT(/) 

All  FORMAT!  ) 

A15  FORMAT!  T12, 'OTHER*  > 

270  F0PMAT!/T1S,'RTS.  BEFORE* »T29. 'PCT.  OF* .T44, 'PTS.  AFTER'. 

• tfb. iPCT.OF ' . T70, 'PCT.OF',TB7.'PTS.' , T99, *PCT .OF » . 

• TIU.'PCT.  0F'/T17,'THRES.'.  T29, 'TOTAL*  .T46. 'THRES.  ' . 

• TSft, 'TOTM.  • ,TH7, 'ThWES. ' , T99 , ' TOT AL ' ) 

275  FORMAT ! 1 w ♦, TS ,' SUBCLASS ', T70 SUBCLASS '. T 1 11 .' SUBCLASS • ) 
R76  FORMAT!/) 

280  FORMAT !T5. A4, T1 7. I6.T29,F6.2»T46, I6.T58, 

• Fft.?.T7f .FH.2.T87, 1A,T99.FA.2,T111 .F6.2) 

PRS  FOPMATI//  riH.'PTS.  ThRESHOLOEO  in  DISPL4Y',1X,I10/ 

• TIS.'PTS.  THRESHOI.DFO  IN  CLASS  IFY  ' , 1 1 0/ 

» T3S. 'TOTAL ' »3X. T 10, T60. »PCT . = ',F6.2) 

pAf,  FORMAT  ( IH,  ,TS,  'CLASS' , T7U,  'CLASS'  ,T1  11  , 'CLASS') 

28  7 FQRf^AT  ! IH,  ,TS,  ' CATEGORY T70,  ' C A T EGOR  Y • , T 1 1 1 , 'CATEGORY') 
288  FORMAT  !T29,  TESF’  .FLO,  ' , 158,  'CLSF  .FLO.  • . T99,  'CLSF .FLO.  » . 

■»  Til  1 THRES.  ' ) 

RETURN 

END 


PRT02850 
PRT02860 

T61.I6.T74.F6.3.T84.F6.3.PRT 02870 

PRT02880 


PHT02890 

PPT02900 

PRT02910 

PRT02920 

PRT02930 

PRT02940 

PRT02950 

PRT02960 

PRT02970 

PRT02980 

PRT02990 

PRT03000 

PRT03010 

PRT03020 

PRT03030 

PRT03040 

PRT03050 

PRT03060 

PRT03070 

PRT03080 

PRT03090 

RRT03100 


FILE  RE0IF3 


SUBROUTINE  RFOIFT (TSTSAV.TSTFLO.TSTVER.VOlMt 

* GTUN1T.GTFILF,AIUN1T,AIFILE.PPUNIT.PPFILE* 

* NAMECTtALP.DESSAVtOESFLO.DESVER.NOFLOA) 
implicit  INTEGER  (A-H.O-Z) 

CODE  ADDED  TO  INCLUDE  LIST  PROCESSING 

REAL  ALP (2) 

cilllllllll.IIIIIIIII— 

'il 


PURPOSE.,  reads  and  ANALYZES  SUPERVISOR  CONTROL  CAROS 
FOR  • OISPLAY* 


Cl- 

E'- 

C 

C 

c 


EQUIVALENCE 


1 


(HF01(n.HEAD(A»).  (DATE 
(HED2(1) «HEAO(30) ) t (COME 


(1) .HEAD (22))* 
NTUl  - 


D.HEAOTaS)) 


CSENO 


INCLUDE  C0MBK6 
INCLUDE  CHHKIO.LIST 

C0MM0N/GL08AL/HEAD(63) .MAPTAP.DATAPE.SAVTAP.RMFILE.BMKFY. 

HISFIL.HISKEY.TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILE. 
DRUMAD.DRMWDS.waGSIZ.DATFIL.STAFIL.ASAV.ASAVFL 
.NHSTUN.NHSTFI .SCTRUN.MAPFIL 

.noTUNT.OOTFlU.NCHPAS.TRNSFL»BMTRFL»HISTFL*PCHUNT» 

CROUNT.PRTUNT.RANOIO 

COMMON/OISPL/CATFLR.CATNAM(61) .CLSNAM(61) »SUBNaM(61) .SUBN0(60) « 
SUaCAT  (60)  .CLSSUEJ  (60)  .NOMAP, T0TVT3.N0SUB3. 
PCFOKY.TSTKFY.TPNKEY.THRSKY.STATKY.EMPTRS.THRSVA, 
PLT-^EV.BMFLr.,RMC0M8.BMFFAT,C0ATE(2)  . 

FLOS VP. FIELD?. VERTX?,FLDSV3,FIELD3.VERTX3,PCT 103. 
THW^S(60) ,SYMMTX(66) .high (60) .CON (60) 
,FL1^KFY,NOFLD?.NOFLD3.NOFET?.FETVC2(30) 
,N0SUn2.N0TRFD.T0TVT2.N0CLS2 
,katno(60) .nocat, filter. MAPFMT 
.OESKFY.DESUNI.DFSOTH.CROP  . ACROP. AOTHER. ATOTAL 
,SITE(6)  .ANALYS(S)  .CAM(15)  ,CHPx:EY,KEPPTS(60) 
.DOTKEY.DOTERR 
REAL  HIGH, CHIN 
REAL  ACROP. AOTHER. ATOTAL. X 

real  THRES 

DIMENSION  OESSAV(4.SO) .DESFLD (S.50) .OESVER ( 1 100) 

DIMENSION  TSTSAV(4,?00) . TSTFLO ( S.200 ) . TSTVER ( VDIM) * 

* OPT (PO) ,COMVEC(?) .INF(7) .ACARO(PO) 

3,COD8CD(10)  .FQUCOMO)  .CARO?  (62)  .CARDl  (BO)  . SLASH (2) 

4 . COMENTdS).  DATEO).  HEDKIS).  HED2(15) 

DATA 


0PT/»SYHBi , *STTE • . *0PT1 t , . THRE * . • ANAL • . 

* »C0MMi . »HFD1 • . •HEO?». 'DATE ». tPROC*. ’ACRE* * 

* •♦END* • 'FORM! . »C»OP‘ . 

* 'GrUN* , * AlUN* . 'PPUN* . 'NAMF* . »ALPH»/ 

DATA  0PTNUM/12/.EN()flC0/*iEND'/.THSBC0/'THRS'/.BLANK/»  1/  . 

1 comma/*.  */.COO-(Cr)/'  •.•S*.*0*.*P*.*N*.*E*.*C*»*T».'F*/ 
?.E0UC0M/2. *=• . *. '/.COMVEC/1 . *, »/.  SLASH/1. •/•/ 

DATA  L0/*0*/,LI/' I ♦/.LF/*F*/,LU/»U*/ 

DATA  LL/'L'/.L5/'S*/.LT/'T*/,LC/*C*/.LN/*N*/.0THER/'0THE*/. 
•UNIDEN/'UNIO*/ 

DIMENSION  SYMMT (66) .EOUVEC (?) 

DATA  SVMMT/* 1 *.'P»,*3'.*4*,*S'.'6*,*7*.*B».*9».»4*.*H*,*C*.*0*, 

1 •F*»*F*.*G*.'H'.'I',»J','K*.*L*,'M».*N*,*0'.*P'.*0*, 

2 i(4i, .51, .Ti,.U*.*V*.*W*.*X*.«Y*.*Z*.*_*.*I*. •->•.•/•< 


DATA 

DATA 

DATA 


TRNSYM.TSTSYM.DOPSYM.THRSYM/*** . t . *s* . * 
OESSrs/*/**/.EOUVEC/l . • = •/ 

C.L/'C'.*L'/ 


t,fx. • 

* / 

• / 


* ( • . • 


REOOOOlO 

REOi)0020 

RE000030 

HE000040 

RED00050 

RE000060 

RE000070 

REDOOOHO 

■IRED00090 

■IREOOOlOO 

IREOOOllO 

IRF000120 

IRED00130 

IRFOOOUO 

IRE000150 

-IRE000160 

•IRE000170 

RED00180 

RE000190 

RF000200 

RE000210 

RE000220 

PEOO0P3O 

PED00240 

—RE000250 

RE000260 

RE000270 

RE000280 

PED00290 

PE000300 

RE000310 

KE000320 

RE000330 

RED00340 

RED00350 

RE000360 

REOOOJ70 

PED00380 

RE000390 

PE000400 

RE000410 

RE00('4?0 

RED00430 

PE000440 

HE000450 

PED00460 

RFU00470 

RE0004HO 

PFD00490 

PE000500 

PEOOOSIO 

RE000S20 

RFO00B30 

PED00540 

PED005S0 

RE0O0B60 

PEQ00S70 

REOOOS80 

PE000590. 

PF000600 

RED00610 

RE000620 

RFO0C63O 

RE000640 

PF000650 

RE000660 

RFD00670 

RE0006«0 

RE000690 

RF000700 

RFD00710 

PED00720 

RE000730 

RFD00740 

RE0007SO 

PF000760 


oooonon  ooooooo< 


FILE  PE0IF3 


LOGICAL*!  LM(4) iLCR0P(4)  RE000770 

EQUIVALENCE  (CAKOa ( I ) «CAR0 1 ( 1 1 H * (HtLM ( 1) ) « (LCROP ( 1 ) tKCROP)  RED00780 

no  S I»l»66  RED00790 

5 SYMMTXdJsSYMMTd)  REDOOHOO 

: REOoneio 

j — — — REOOOG20 

I ................................... ..............RED00ii30 

RED0OU4O 

INIZ  RE000850 

— ........................................ -RED00860 

REOOO07O 

• REOOOHHO 

•**  CODE  added  NOV  13»  1978  TO  INCLUDE  LIST  PROCESSING  RED00890 

RE000900 

6TUNIT  s 0 RE000910 

GTFILE  » 0 RED00920 

AIUNIT  » 0 • RED00930 

AIFILE  = 0 RE000940 

PPUNIT  s 0 RED00950 

PPFILE  = 0 RED00960 

NAMECT  3 BLANK  RE000970 

ALPd)  3 0.  RFD00980 

ALP (2)  s 0.  PFD00990 

D0TERR=0  REOOIOOO 

OOTKFY  = 0 RFDOIOIO 

TSTKEY  * 0 RED01020 

TPNKEY  s 0 RED01030 

STATKY  3 0 RE001040 

PCFOKY  3 0 REOOiOSO 

PLTKEY  3 0 RED01060 

MAPFMT  3 0 RE001070 

NOMAP=l  RE001080 

FILTERsO  RED0i090 

THPSVA  3 0 PEDOllOO 

FMPTRS  = 0 REDOlllO 

SYMCNT  3 0 RE001120 

THRSKYsO  REO0li30 

STOPPG  3 0 REDO  11 40 

GRPTR  3 0 RFOUllSO 

NOGRP  3 0 PAGE  TS 

NOTRFO  3 0 (),/ 

TYHEso  j '-/( )R  QIjALITY 

CRPKEYsO  , ^ 

THSCNTsO 
DFSKEY30 
TSTCNT  3 0 

LOGSWT  3 0 

PCCLKY  s 1 

SYMMAX  3 60 

DO  6 Isl.SYMMAX 
THPESd)  3 0 

6 CONTINUE 
NOFL03s200 


READ  IN  SUPERVISOR  CARDS 


SET  UP  REREAD  BUFFER 
RRUNIT330 

CALL  REWEAOlRRUNIT.aO) 

NOW  RF.AD  THE  CARD  INTO  THE  BUFFER 


PFD01160 

RE001170 

RED01180 

RFD01190 

RE001200 

PEU01210 

RE001220 

RE001230 

RED01240 

REO012S0 

RE001260 

RED01270 

RED01280 

RE001290 

REDO1300 

RF001310 

RED01320 

RE001330 

REOU1340 

RE001350 

RE001360 

RED01370 

RED01380 

RED01390 

RED0140Q 


RED01410 

10 

CONTINUE 

RE001420 

IS 

RFAn(21. 180)  (ACAROd)  .I»l*20> 

RED01430 

180 

FORMAT (POAA) 

RE001440 

WRITE (RRUNIT. 180) ( AC ARD d ) ♦ 1=1 ,20) 

RE0014SO 

RFWINO  RRUNIT 

PF001460 

REA|)(30»104)CODE«CAR02 

REDO  14  70 

lOA 

FORMAT (A4,6X,62Al) 

RED01480 

REWIND  RWUNIT 

RED01490 

17 

WRITE (6.304)  C00E,CARD2 

REOOISOO 

304 

FORMAT  ( T7*  A4»6X»t>?Al ) 

RFOOISIO 

19 

COL  3 0 

RE001520 

FILE  RE0IF3 


I 


20 

^ 100 

00  20  I«l»20 

IF(0PT(1) .ECi.CODEIGO  TO  ( I00*200»300«400«600*7l0»720*730* 
* ^ .740.760.770ffl00t750.780»210»211»212»230»240) # I 
CONTINUE 
GOTO  1500 

GET  SYMBOLS 

RED0153Q 
HED01540 
RE001S50 
REDO 1560 
RFD01570 
REOOi580 
REOOi595 

IF  ( SYMCNT  .GE.  SYMMAX  ) GOTO  10 

RE001610 

RED01620 

SYMCNT  = SYMCNT^l 

RC001630 

SYMHTX (SYMCNT)  » BLANK 

RE001640 

M = NXTCHR(CAB02.C0L) 

RC001650 

IF  ( M .EO.  BLANK  ) GO  TO  10 

PE001660 

IF  ( M ,Et).  COMMA)  GO  TO  100 

RE001670 

no 

SYMMTX(SYMCNT)  = CAR02(C0L) 

RE001680 

M = NXTCHH(CAHD?*COL) 

RED01690 

IF  ( M .EO.  BLANK  ) 60  TO  10 

PE001700 

IF  < M .NE.  COMMA  ) 60  TO  110 

RE001710 

c* 

GO  TO  100 

RE001720 

REo01730 

c* 

SITE  NAME 

RE001740 

c* 

RE001750 

200 

PEAO(30.?01)S1TE 

RE001760 

201 

FO»MAT(10Xt6A4) 

RE00|770 

REWIND  RRUNIT 

RED01780 

GO  TO  10 

RED01790 

C 

. RED01800 

c*** 

CODE  ADDED  NOV  13«1978t  TO  INCLUDE  LIST  PROCESSING 

RFOOIHIO 

c 

RF001820 

c*«* 

READ  GT  AI  OR  PP  UNIT  AND  FILE  NUMBERS 

PF001830 

210 

IPAT  = 16 

RE001840 

GO  TO  214 

RF001850 

211 

IPAT  s 17 

RE001B60 

GO  TO  214 

RE001870 

212 

IPAT  = !M 

RF001880 

214 

M s NXTCHS(CARD2.COL) 

RFD01890 

IF  (M.EO. BLANK)  GO  TO  216 

RED01900 

IF  (M.NF.LU)  GO  TO  215 

REDO  1910 

M = FIN012(CABD2tCOL»EQUVEC) 

RED01920 

IF(M.NE.2>  GO  TO  216 

RF001930 

ISTAPT  = 0 

RF001940 

M 5 NI)MME»(CAHD2.C0L.IPATT,ISTART) 

RE001950 

M = FIN012(CARD?.C0LtEQUVEC) 

RFD01960 

IF('-.NE.2)  go  to  216 

RE001970 

ISTAWT  = 0 

RE001980 

M = NUMMtR(CAWD2.COL*IPATTTtl5TART) 

RF001990 

GO  TO  218 

RED02000 

215 

IF(M.NF.LF)  GO  TO  216 

RF002010 

M = FlNni2(CAWD2,COL.EQUVEC) 

RF002020 

IF  (M.NF.2)  60  TO  216 

RED02030 

ISTaRT  = 0 

RF002040 

M = NiiMHEM(CA«02fC0LtlPATTT.lSTART) 

RED02050 

M = FINi)12(CA«D2.COLtEOOVEC) 

PFD02060 

IF (M. ME, 2)  GO  TO  216 

RF002070 

ISTART  = n 

RFD02080 

M = NUMBe;R(CAR02.C0L»IPATT.ISTAHT)  > 

RE002090 

GO  TO  218 

PF.D02100 

216 

WRITE(6,217)  OPT(IPAT) 

RE002110 

217 

FORMAT (•  ERROR  ON  »»A4*»  CONTROL  CARO  •) 

RF002120 

60  TO  10 

PF002130 

218 

IF(IPAT.nE.16)  GO  TO  219 

RED02140 

GTUNIT  = IPATT 

RE002150 

gtfilf  = ipattt 

PED02160 

GO  TO  221 

RED02170 

219 

IFdPAT.N.- ,17)  i 0 TO  220 

RFO02lfl0 

AltJNIT  = IPATT 

RF002190 

AIFILF  = IPATTT 

PF002200 

GO  TO  221 

RFD02210 

220 

PPUMIT  3 IPATT 

RF002220 

PPFILE  = IPATTT 

RF002230 

221 

OOTKFY  a 1 

RFO022A0 

GO  TO  10 

RFn02250 

C»**  SELFCTED  LIST  CLASS  NAME 

RF002260 

230 

NAMFCT  = rXTCHR(CAR02,COL) 

RFf)02270 

IF  (NAMFCT, NE. BLANK)  60  TO  10 

RF.002280 

d 


rir>on  oooo  no  oo  oo  ooo  or>  oo  noonooo 


FILE  PE0IF3 


*<RITE(6,23*i) 

format (*  NO  NAME  APPEARS  ON  SELECTED  CATEGORY  CARO  •) 
NAMECT  « LS 
GO  TO  10 

VALUES  FOR  ALPHA  IN  BIAS  CORRECTION 

M B FLTNUM(CAR02.C0L.ALPf2» 

IF  (M.F0.2)  60  TO  10 
WRITE(6.2A5» 

format (•  ERROR  ON  ALPHA  CARD*  DEFAULTING  TO  ZERO  *) 
ALP(l)  » 0. 

ALP<2>  » 0. 

' GO  TO  10 


OPTION  CARO 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


300  M S NXTCHR(CAR02*C0U  RE002A90 

DO  310  I=l«9  REU02500 

1F(M.EQ.COOHCO(I))GO  TO  ( 10*3AOt360*380*38S* 395*  RE002510 

>*  397»3V(3f  399)  »I  RE002520 

310  CONTINUE  PE002530 

315  WRITE(6*3152)  CODE*  CARD2  RE002540 

3152  format (////  5X,*****  DSPLAY/RE01F3  — ERROR  IN  »»OPTION»«  CARF002550 

*PD  ...•//5X,2H'*»A4*6X.f.?A1.2Hi»//5X.*****  SCAN  OF  THIS  CARO  DISRE002560 

2C0NTINUe0  proceeding  to  next  CARD  •***•  ///)  RE002570 

GO  TO  10  RED02580 

RE002590 

RE002600 

340  STATKY  = 1 RE002610 

GO  TO  390  RF002620 

PE002630 
RFO02640 

360  TRNKEY  = 1 RE002650 

GO  TO  390  RF002660 

RE002670 

RE002680 
RE002690 

300  M=NXTCHR (CAR02*COU  REC >2700 

IF (M.EO.C)PCFDKY  = l RED. 2710 

IF«M.Ei)tL)RLTKEY  = l RFO.'2720 

60  TO  390  REl)0?730 

RED02740 

RE002750 

385  NOMAPsO  PED02760 

RE002770 

PEn02780 

390  M = FjN012(CARD2*C0l.iE0UC0M)  RED02790 

IF  ( M ,LE,  0 ) GO  TO  10  RE002BOO 

GO  TO  300  RF002810 

PED02820 

- — SET  THRESHOLD  AEYS  FOR  EMPERICAL  THRESHOLDING. TURN  OTHERS  OFF  RED02830 

395  THHSVAsO  REOO204O 

EMPTRSs?  PED02850 

THRSKY=2  RE002860 

GO  TO  390  RED02870 

RF.002880 

RFD02890 

RE002900 

— SET  THRESHOLD  KEYS  FOR  CHI  SQUARE  THRESHOLDING. TURN  OTHERS  OFF  RED02910 

397  FMprPSsO  PED02920 

THRS7A=0  PK002930 

THHSKY=1  RLU02940 

GO  TO  390  RE1)0?9SO 

PE00PV60 

— — — RFO0P970 

RF.DOP980 

- — SET  THRESHOLD  KEYS  FOR  INPUT-VALUE  THRESHOLDING.  TURN  OTHERS  OFF  RPnoao-jo 

398  FHPTRSsO  PFOO360O 

THPSVAs3  • RFOOiriO 

THRSKY=3  RF003020 

GO  TO  390  PFOOTOIO 

C-  CHECK  FOR  FISHER  UR  FILTER  REU03C40 


360  TRNKEY  = 1 
GO  TO  390 


300  M=NXTCHR(CAR02.COU 
IF (R.EO.C)PCFDKY=l 
IF«M.Ei).L)RLTKEY  = l 
60  TO  390 

385  NOMAPsO 

390  M = FJN012(CAR02.COL.EOUCOM) 

IF  ( M .LE.  0 ) GO  TO  10 
GO  TO  300 

■ — SET  THRESHOLD  KEYS  FOR  EMPERICAL  THRESHOLDING. TURN  OTHERS  OFF 

395  THRSVAsO 
EMPTRSs2 
THRSKY=2 
GO  TO  390 


— SFT  THRESHOLD  KEYS  FOR  CHI  SQUARE  THRESHOLDING. TURN  OTHERS  OFF 
397  FMprPSsO 
THPS7A=0 
THRSKY=1 
GO  TO  390 


ooor>  oooo  oooo  nono  ooor> 


FILE  RE01F3 


399 


qOL»COL^|^ 


M«NXTChR(CA«02.COL) 
IF(M.';w,LL)60  TO  3990 
!F(H. FQ.LS)G0  TO  3991 
GO  TO  31G 
3990  FILTER* I 
GO  TO  390 


C- 

3991 


3992 

3993 

3994 


3995 


S: 


IXsO 

00  3995  l*l»N0SUi?2 

IF(KEPPTS< I) .GT.N0FET2JG0  TO  3995 

1F(IX.NE,0)GO  TO. 3993 

MRIT£(b«3992) 

FORMAT (1H0»////) 

IX*I 

WRITE(6»3994)  I . KEPPTSm  • NOFET2 
PORMATC  ***••  FISMER  THRESHOLD  REQUESTEO-NOT 
1'...  NO.  samples  for  SURCLASS'.IG.* IS 
2 TO  NUMBER  OF  CHANNELS  16. •)*♦/) 

CONTINUE 

IF(ix,EO.O)GO  TO  3996 
WRire(6.3992) 

GO  TO  390 


— SET  THRESHOLD  KEYS  FOR 
3996  EMPTRS=0 
THRSVAxO 
THRSKY«4 


GO  TO  390 

RE4D  IN  THRESHOLDS 


FISHER  THRESHOLDING. TURN  OTHERS  OFF 


400 


« 


continue 

I = SYMMAX-THSCNT 

THSCNT  * THSCNT*FLTNUM(CAR02.C0L.THRES(ThSCNT*1 
GO  TO  10 


analyst  name 


600 

601 


REflOnO.601)  analys 

FORMAT ( 10X.SA4) 
REWIND  RRUNIT 
GO  TO  10 

COMMENT 


710  READ  <30.9998)  COMENT 
9998  format  (10X.15A4) 
REWIND  RRUJir 
GOTO  10 


HEOl 


720  read  (30.9998)  HEOl 
rewind  RRUNIT 
G(5T0  10 


HED2 


730 


RFAO  (30.9998)  HED2 
REWIND  RRUNIT 
GOTO  10 


DATE 


740  read  (30.9998)  DATE 
REWIND  RRUNIT 
GO  TO  10 


RE003050 

PE003060 

R^D03070 

RE003080 

RE003090 

RE003100 

RED03110 

RE003120 

RE003130 

RF003140 

RED031S0 

RE003160 

RE003170 

HE0031flO 

RE003190 

RED03200 

PERFORMED* ./.0X.  PED03210 

LESS  THAN  OR  EOUALRE003220 
RE003230 
RED03240 
PE003250 
RED03260 
RE003270 
RE003280 
RED03290 
RE003300 
RE003310 
RE003320 
RE003330 
RE003340 
REO033S0 
RE003360 
Rfc003370 
RE003380 
RED03390 
RE003400 
RED03410 
PE003420 
RE003430 
RE003440 
RED03450 
RE003460 
REO03470 
RE003480 
RF003490 
RE003500 
RE003510 
WFD03520 
RFD03530 
RED03540 
RED03S50 
RE003560 
HED03S70 
PF003580 
RFD03590 
RED03600 
REO03M0 
RED03620 
RE003630 
RED03640 
RED036C0 
PFD03660 
RED03670 
RFDO3hR0 
RFn03690 
RED037C0 
HED03710 
RF003720 
REDO3730 
RFD03740 
RFD037S0 
RFD03  IHO 
REDO  <770 
Rri)>i3780 
RF003790 
RE003800 


) .11 


I 


FILE  RC0IF3 


\ MAP  TAPE  format 

'750  M*pNXTCMrt7cARoiTcOU 

iF(M,EO.LU)MXPFMT*l 
F(M.tO,LUMXPFMT*2 
F(M,6o.BL4NK)MAPFMT»I 
60  TO  10 


PROCEDURE  CONFIGURATION  TITLE 

760  REAO(30*999e)CAMS 
REWIND  RRUNIT 
60  TO  10 

ACREAGE 


j: 

c* 


ORIGINAL  page  IP 
OF  POOR  QUALin 


770  M*NXTCHR(CAPD2tC0L) 
lF(M.feO,BLANK)GO  TO 


IF(M,tQ.COMMA)GO  TO  770 
JsFIN012»CA«D2»t0L.EQUC0M) 
IF(J.E0.?)G0  TO  773 


77? 

773 


C* 

C* 

C* 


FoiiHATt*^*ERROR  IN  ACREAGE  CARD  • CARO  16N0RC0M 
GO  TO  10 

J » FLTNUM(CAR02.C0L.Xtl) 

IF(M.E0.LT)AT0TAL=X 
IF<M,eo.LC) ACROPaX 
IF(M,EQ.L0) AOTHEMaX 
GO  TO  770 

INTENSIVE  STUDY  CROP  NAME 


C* 

( 

c* 

C* 


C- 

c- 

C- 

c- 


780  MaNXTCHR (CARD?. COL) 

KEp^PaBLANK 

CPPKEY-1 

781  LCWOP<IC)sLM(l> 
CROPxKCHOP 
IC=IC*1 

1F(!c.GT,4)G0  to  10 
MsNXTCHW(CARn?*COL) 
IF(M.EO.BLANK)60  TO  10 
60  TO  781 

800  CONTINUE 


8?7 


C* 

C* 


A?5 

830 


•END*  end  of  CONTROL  CAROS  - NOW  FIND  CHI-SQUARE  THRESHOLDS* 
THEN  HEAD  IN  TEST  FIELDS 
F (THSCNT  ,E0.  0)  GO  TO  830 

F THRESHOLDS  WERE  INPUT  WITHOUT  OPTION  - ASSUME  CHI-SOUARE 

F(THRSKY.EO.O)THPSKYal 
NOEGR  = NOFET? 

IF  (8MFLG  ,GT,  0)  NOEGR  » BMC0M8 

BYPASS  IF  NOT  EQUAL  TO  1 OR  2. 

IF(THRSKY.GT.2)  GO  TO  830 

00  A25  MZ=1. NOSUB? 

HIGH(M7)  a 1.  - THRES(MZ) 

THRES(MZ)  r CHIN(hIGH(MZ) ,N0EGR*FLA6) 

IF(FLAG.EQ.l)  GOTO  826 
GO  TO  82S 

WP!TF(htH27)  M7,THRES(M7» 

forhak//  ' ***  A threshold 
• - 1*  therefore 

3**ci  ,I6tF15.5//) 

THPSKY  a 0 
60  TO  830 
CONTINUE 
CONTINUE 


OLD  VALUE  IS  OUTSIDE  THE  ALLOWABLE  RANGE 

NO  thresholding  has  been  done  in  This  run 


NOW  READ  test  OH  DESIGNATED  FIELDS 


RCD03810 

RED03A20 

R|u0383g 

REoSiB^S 

RE003H6g 

RED03870 

RFD0386g 

rED03890 

RE003900 

RfO039lg 

RE003920 

RED03930 

REQ03940 

RED039S0 

RED03960 

RE003970 

RED03980 

RED03990 

REDOAOOO 

REQOAOiO 

RED040|g 

RFOOAOSg 

RED04040 

Rf 
RE 

REDOAOHO 

RED04090 

REOOAlOO 

PEOOAiiO 

REDOAlEO 

PE004130 

RL004140 

RF004150 

RED04)60 

RED04170 

RE004180 

RE004190 

RF004200 

REU042I0 

RED04220 

RED04230 

RED04240 

RED042S0 

RE004260 

RE004270 

RFD04280 

RED04290 

RE004300 

RED04310 

RE004320 

RE004330 

RE004340 

RE004350 

RED04360 

RE004370 

PED04380 

RE004390 

RE004400 

RED04410 

RE004420 

RE004430 

RFD04440 

RED04450 

RED04460 

RF004*70 

0PEO04480 

REOO4490 

RE004600 

PF004510 

RFD04520 

RFO0AS30 

RED04540 

REU045S0 

RED04S60 


w 


FILE  RE0IF3 


ICK»LAREAO(T! 

1F(1ck,EQ.-2) 

!F(fCK.EQ.-ll 


Ct<»LAREAO(TSTSAV ( 1 1 N0FL03)  »TSTVER( IPT)  ♦ INFtNV) 

F(ICK.E0.-3)60  TO  B65 

F(lCK,£Q.-2)GO  TO  850 

F(fCK.E0.-l)60  TO  860 

FCICK.EQ.  0)GO  TO  870 

STSAV(2tN0FL03)=CLSIN0 

STSAV (3.NOFLD3>=SU8!no 

STSAtf {«,NOFLn3)»NV 


TSTFLO<1.NOFlD3)=*INF<1» 

TSTFL0(2.N()FL03»«1NF(2) 

TSTFL0(3tN0FL03)»iNF(A» 

TSTFL0(4tNOFL03)»INF<5) 

TSTFL0<5tN0FL03»=IPT 
IPTsTPT  ♦ 2*NV 
N0FL03  s N0FL03  ♦ 1 
TOTVT3sTOTVT3*NV 
60  TO  840 
SUBCLASS  NAME 

» BEAO(30»B51)NAME 
REWINO  RRUNIT 
1 FOt^MAT  UOXfAA) 
no  BS2  I=1.N0SUB2 
lF(NA‘*£.EQ,SUBNAM(m60  TO  854 
COMTlNUe 

WBITF(6t8S3)NAME 

» format <•  *EMHOR  ON  SUBCLASS  NAME  CARO  -»*A4f»  DOES 
•CLASS  FROM  THE  MAPTAP  FILE  *•) 

CALL  CMERR 
k SUBINDsl 


NOT  match 


CLS1ND=CLSSUB(I) 

60  TO  840 

CLASSNAME  CARO 

) PEAr)(30.851)NAME 
REWIND  RRONIT 
00  BM  I*1.N0CLS2 
IFINAiAf  .EU.CLSNAH(l)  )60  TO  863 

I CONTINUE 

WRITE (6»86?)NAME 

» format  (•  *F.WROR  UN  CLASSNAME  CARO  -‘tAA**  DOES  NOT 
•AMP  FROM  THE  MAPTAP  FILE  •*> 

CALL  CMERR 

I CLSlNO=f 
SUBINO=0 
GO  TO  840 

OESI6NATEO  FIELDS  . 

* REAnoo.flSl)  TEST 
REWIND  RRUNIT 
SU«INl)=l 

CLSINt)  = NOSUB  T ♦ 4 
IF  (TEST.E'J.OTHEkISU81NO«2 
IF  (TFST.EO.OThFR)CLSIN!)=NOSUB3*5 
IF  (TEST. NE.OTH'^R. AND. TEST, NE.UNIOEN)GO  TO  8066 
ICK=LARFAr)(nFSSAV(l  ,N0FLD4)  ,OESVEH(PPT)  f INF.NV) 
IFtICK.tU.-3)00  TO  H65 
IF(ICK.E0.-2)G0  TO  850 
IF < ICK.FO.-l )G0  TO  860 
IF  ( ICK.f 0.0)60  TO  870 
OEBSAV  (?,’JijFLD4)=CLSIN0 
DESSAV  (3.U0FL04)  sSlIBINO 
OEPSAViA.NOFLOAjsNV 
DF«iFLU(l,U0FLI)4)  = INF(l» 
nFSFLO  (2,UiiFLl)4  ) = 1NF  12) 

DESFLD ( ItNOFLOA)  = INF (4) 

DESFLD l4,NuFLn4 )=INF (5) 
nFSFLU(b.NOFL04)=PPT 


MATCH 


RE004S70 

r|004580 

PE004590 

REQ04600 

RE004610 

sfghsss 

S|g8tll8 

rE004660 
RE004670 
RE004680 
RFnQ469Q 
RE004700 
RE004710 
BE004720 
PED04730 
RE004740 
PE004750 
FF004760 
RE004770 
RE0047BO 
RED04790 
RC004800 
REP048I0 
RF004B20 
RE004830 
RE004840 
RE004850 
RF004B60 
RFD04870 
REOO408O 
:h  a SUBRF004890 
RF004900 
RE004910 
RED049P0 
RF004930 
RF004940 
RE004950 
RE004960 
RF004970 
RE004980 
RE0049O0 
RE005000 
RE005010 
RE005020 
RED05030 
CLASS  NRF005040 
RE005050 
RFn05060 
RE005070 
RFU0S080 
RE005090 
REDOSlOO 
RFOOSllO 
RE00S120 
RE005130 
PE005140 
HED0S150 
PFO0S16O 
RFO0S170 
RF00S180 
RE005190 
PEOOS200 
RFO0S210 
RED0S220 
RFD05230 
RE005240 
PFnO‘^250 
RE00S260 
RFD05270 
REOOS2BO 
RFOOSe-RO 
RFO0S300 
PFO0S310 
RE00S320 


^^7 


FILE  RE0IF3 


PPT*PPT*2*NV 
N0PL04>N0FL04*] 
60  TO  6065 


THIS  CODE  ADDED  AUG  31*1976  TO  ALLOW  ClASSNAME  TO  APPEAR 
ON  designated  card  THIS  FORCES  MECLASSIFICATION  OF 
DESIGNATED  PIXELS  INTO  THE  FIOST  SURCLASS,AS|l6NE0^ 

TO  THE  CLASS  NAMED  ON  THE  DES16  CANO  STARTING  AT  COL  11 


6066 


n IcL^NAHCin  60  TO  666 


866 

4005 


TO  667 


CONTINUE 
WRITE (PRTUNT. 4005)  TEST 


format (•  designated  field  of  CLASSNAME*.A4.*D0ES  NOT 
HATCH  A CLASSNAMF  ON  MAPT AP— 0EFAULTIN6  TO  UNIOENO 


667 


GO  TO  4065 


DO  666  I 
IF  (II.NE 


>1*60 
.CL  ■ 


LSSUG(I))  60  TO  666 


868 

4006 


CLSlf_ 

60  TO  669 


continue. 


(PRTUNT.4006)  test 
format (•  DE5IGNATFD  F lELO • *A4t ‘CANNOT  BE  MATCHED 
defaulting  TO  UNIDENTIFIABLE*) 

60  TO  6065 


SEND* 


END  OF  TEST  OR  DESIGNATED  FIELDS 


669 

?: 

c» 

870  N0FL03  « N0FLD3-1 
N0FL04sN0FLD4-T 
IF(  N0FL03.GT.0)TSTKEY«l 

CODE  ADDED  NOV  13*1978  TO  INCLUDE  LIST  PROCESSING 
C 

IF  (OOTKEY.EQ.O)  GO  TO  900 
TRfMEY  ■ 0 

continue 

IF(  N0FLD4.GT.0)0ESKEY»1 


900 


C» 

C« 

C* 


SET  THRESHOLD  AND  OUTLINE  SYMMflOLS 


SYMMTX (N0SUR3) «ThRSYM 
SYMMTX (NOSUH3*! ) eTRNSYM 
SYMMTX  (NOSUfi3*2)  »TSTSYM 
SYMMTX (NOSUrt3*3) aDUPSYM 
SYMMTX (N0SUa3*4)sDESSYM 
SYMMTX (N0SUM^*5) sDESSYM 


• s- PAGK  IS 
POOU 


60  HOME 


RETURN 

ERROR  ROUTINES 


1500 

15002 


RE005 

sgst 

RfOOS 
{DOS 
DOS 


Rl ^ 

RE005390 

RE006400 

R|0054i0 

si8sl:lll 

005461 

g0549( 
0550( 
_0055l< 
RED055|( 

re6o|||0 

rIoosIto 

RE005560 

PE00S590 

RE005600 

RF.O0S610 

RE005620 

PEOOS630 

RE005640 

RE005650 


RC005660 
:005670 


RE005660 

REOOS690 

RE005700 

RED05710 


RE005720 

RF005730 


F0RMAT(/1X,44?6X*62AI/»  INVALID  CONTROL  CARO-CHECK  SPELLING  OF 
» WORD*) 

60  TO  10 
END 


RE005740 

RE005750 

RE005760 

REO05770 

RFO0S780 

RF005790 

REOOS800 

REDOSblO 

RE005820 

RE005830 

RE005640 

REO0SH50 

RFOOS660 

RED05870 

RE005660 
PE005890 
RE005900 
RF005910 
— — RE005920 
REO0S930 
RE005940 
KEYRED05950 
PEOOS960 
PEn05970 
REO0S960 


fiLPi  «NORM 


FORTRAN 


TtON  RNORM(X) 
A(7> 


FUNCTION 

DIMENSION 

DATA  A /. 


* .RZTOSJTE 

YbARS(X)/1.A1A213 
RNORMsQ. 

DO  1 I»l,7 
PNORM«RN0»M*Y*A{|> 


A3063AE-A..276567?F-3,.lS201A3E-3. 

2* . A22S2o£- I * . t0S23E*l « 1 .0/ 


CAM,  OVE«FL(INOCf) 

TFCINOCT.NE.2)  00  TO  3 

1 CONTINUF 

RNORMb.6,*  ( ( ( ( ( I ,/PNORM>  •*2>  ••2) ••21 

2 TF(X,6T.i).0»  unORM  « l.O-RNORM 
return 

3 RNORm«0,0 
00  TO  2 
END 


PNOOOOIO 

RNU00020 

RN00003Q. 

RKOOOOAO 

RNOOOOSO 

RN000060 

MNQftOOTO 

RN000080 

RN000090 

RNOOOlOO 

HNOflOilO 

RNOOOI20 

RNOCOI30 

RNOOOUO 

RNOOOlSO 

RN000160 

RNO00I70 


FILE  SETUPS 


ORIGINAL  PACK  V 
OP  POOR  QUAl.n  ' 


SUHrtOUTlNf  SFTUP3<APRAYfTOPtOTUNIT*6TFlLE» 
»IUNir.AlPfLF.PPUNlTtPPnLE.NAMECTtALP*0£5SAVf 


• lUNi  I lur  I trrr 

DFSFLO.OeSVt>l»NOFLO*»STOP) 
IMPLICIT  IMUGFK  (*-2) 


;•••  CODE  added  NOV  13.1978  TO  INCLUDE  LIST  PROCESSING 

m 

REAL  ALP(2I 
LOMCAL  OKAY 

: INCLUDE  CUMMKA.LIST 

: INCLUDE  CM.mlO.LlST 

COMMON/OLOHAU/MtAO(6:i)  .MART  AP.  DAT  APE  .SAVTAP.BMFILE.BMKEY.^ 

MISFIL.hISKEY.TRFORM.ERIPTP.ERPK£Y»MAPUNT»NOFILE. 
0RUMAn,DRMWDS.PA(»S17.0ATFIL.STAFiL.ASAV.ASAVFL 


.NHSTUN.NHSTF I .SrTPUN.MAPFIL 
.nOTUNT.DOTFIL.NCMPAS.TRNSFL.BMTRFL.MISTFL.PCHUNT* 
CHDUNI  .?hTUNT.‘'ANOIO 

C0HH0N/DISPL/CATCLG.CATNAMI61) .CLSNAMI61) .SUHNAH (61 ) .< 
5UHCAT(60) .CLSSUH(60) .NOMAP.TOTVT3.n5SUB: 
PC^i^KY,TSTKFY.TRNKF.Y.TriRSKY.STATKY^EMPTRl 


PL  Tf.t  V.HMFLG.HMCOPR.RMEEAT.COATE  (2)  » 
F(  DSV?,FlEL02»VERT*2.FL0Sv3.FIEL03tV^ 
THw^S(^nl ,SYmmTX(A6) .hIghiao) »CON(60r 


>UBNO(60)  * 

I. 

i.THRSVA. 


VERTX3.PCTI03. 


CSENO 

C 


.FL  >KFY,NOFLD2.NOFLn3.NOFF.T2»F£TVC2(30) 
,M)SUM2.NOTRFn.TOTVT2.NOCLS2  . 

.K ATND(60) .NOCAT.FILltR.MAPFHT  ^ . . 

« nt  SHF  Y.OE‘='UnT.OFSOTH.  CROP  .ACROP.AOTMFR.ATOTAL 
,sm  (A»  .ANALYSIS)  .CAM  ( IS)  .CRPKEY  .KEPPTS  (601 

.ootkey.ooterr 


DATA  A/'A*/,0/iNO»/ 
DATA  BLANK/i  •/ 


8! 

c{ 

SI- 

8 

c* 

C* 

c* 

c« 


c 


PURPOSE . 


LOCATES  FILE  ON  tMAPTAP*  ANO  COORDINATES 
ROUTINES  TO  ANALYSE  ‘DISPLAY*  CONTROL  CAROS 


C 

C 


C 

C 


DIMENSION  nUMVEC (TO) .FlLVEC (?) 

niRFNSlUN  OESS/*Y  (4, SO)  ,Df;SFLD(S.50)  .OESVER(llOO) 
DIMENSION  CARO(*i?)  .ARRAY(I) 

DIMENSION  00TCAT(A2) 

EOUIVALENCF  ( OUTCATd)  . CARO(l)  > 

DATA  YSCD/  'Y*  /.  NHCO/  ‘N‘  /.  FlLVEC/  I . *F‘  / 

dimension  E0UVEC(2) 

DATA  DRUM/ t DRUM*  / 

DATA  UHCD/‘U‘/.FflCO/'F‘/.IHCD/‘I'/.EQUVEC/l»‘»'/ 
DIMENSION  SLASN(2) 

DATA  SLASH/l.'/'/ 

INIZ 


READ  FIRST  CONTROl.  CARO  FOR  MAPTAP  UNIT  ANO  FILE  NUMBER 

RFA|)(C»OUNT.  1 ) CARO 
FOR'^fll  ( 11X.62A1 ) 

NFILF.  = 1 
rOL  s 0 

j s nxTCmR (CARD. COL) 

IF  (J.FO.HLANK)  GO  TO  6 
IF  (J.NF.UMrO)  GO  TO  3 
J = FIM)12(LAR(J.C01..EQUVFC) 


SETOAOIO 

SET00020 

SFT00030 

SFT00040 

SCTOOOBO 

SET00060 

5ET00070 

SET00080 

IIUIIII 

SFTOOlIo 
SET00120 
SFT00130 
SETOOUO 
SET 00  ISO 
SFT00160 
SET00170 
SETOOiflO 
SET00190 
SFT00200 
SETOOi 
SETOO; 
ISTOOt 
SEr00240 
SFT002SO 

IFISSm 

SET00280 

S|T00290 

SFT00300 

SET00310 

SET00320 

SET00330 

ISET003AO 

•|SET003SO 

ISET00360 

ISET0C375 

SET00380 

1SET00390 

iSFTOOAOO 

•ISETOOAIO 

SET00A20 

SET00430 

SET00440 

Sf tooasc 

SET00460 
SET00470 
SETOOA80 
SFT00490 
SETOOSOO 
SETOOSiO 
SET00S2O 
SET00530 
SETOOSAO 
SFTOOSSO 
Sf T00S60 
SET00S70 
5ET005A0 
SET00S90 
SET00600 
— SFTOOMO 
SET00620 
SETOON30 
SFT00640 
SET0O6SO 
5ET00660 
SET00*)70 
SFTOO^riO 
SFT00490 
SET00700 
SFT00710 
SFTP0720 
SET00730 
SF.T00740 
SET007S0 
SETOO 760 


FILC  SETUPS 


«S 


IF^U|NE.?»  GO  TO  6 

J ■ 


NUMRfS  I C AHI) . COL  * M APT  AP 1 1 ST  ART ) 
riNOl2(CARO.rOL»COUVlC) 


[T00770 

-|o;ec 


\wjn 


h GO  Td  6 


J >.NUMRENCCAMa«COLtf#lLC«lSTART) 

GO  TO  10 

3 IF  (J.NE.IRCD)  go  TO  a 

U > FiND12(CAnn«C0LtSLASH) 

IF. (J.NL.I)  GO  TO  A 
J > NxTChR(CARO*COL) 

U ld:18:£,§?8!  « I 

GO  TU  6 

A IF  IJ.NE.FACO)  60  TO  6 

5 J > FIN(Jl|(CAWO«rOL*£OUVEC) 

If  go  to  6 

iSTArt?  a 8 

J a NUHHCPICAMnfCOLtNFlLEilSTART) 

J > F1N012(CA»4i)«C0L«E0UVCC) 

IF  (J«NC*2)  60  TO  A 
fSTAwt  a 0 

J ■ NUMUERlCAHD.COLtMAPTAPflSTARTl 

GO  TO  10 

6 UMlTf(Atn 

7 FORMAT i t FRROR  on  MAPTAP  CARO* I 

10  CONTINUE 

IF  (NFILE.LE.n)  NFILC  ■ I 
SEHIAL  « NFILE 

GET  TAPE  REAOr 

40  REWIND  MAPTAP 

IF  ( NFIL^  .EO.  1 » 60  TO  SO 
NF  » NFILF  - 1 ... 

CALL  FSHSFL (KAPTaP.NF.ISTATI 

IF  Tistat  ,eci.  o»  go  to  so 

W«ITF(6.  a5)  NF.  ISTAT 

F0WMAT(////  !•••••  DSPLAY/SETUP3  ERROR  CONDITION  ON 

__  MAPTAP  0VER*»1A»3X. •FILES*//  SX» 


[OlOAO 

oioso 


IPT  TO  POM 
2 FS*<SFL  status  CODE  * 1 A«3Xf  • . . . 

REWIN.)  MAPTAP 
CALL  CMEHH 

READ  MAPTAP 


ABORTING  RUN 


ATTEHSgl 
/IHlli 


’TO  200 


•SETOl 


READ  TMAPT AP»  COATF  1 1 ) .COATE (?) .RNFI  6.BMC0MH,BMFEAT»N0CLS2» 

• N0H.l)?.N0Sy(*2.N0FtT?.T0TVT2. NOCAT,  VARSZ2» 

• (FtTvC?( I) ,Ial,N0FFT2) 

NCATsNOCAT 

|F(NOC4T.GT,0)GO  TO  55 

CATFLGsO 

NCAT=N0CL5? 

C*  SET  RASE  ADDRESSES  FOR  TRAINING  FIELD  INFORMATION 

55  continue 

NOSUM3snOSUB2*1 

FL('SV2al 

VEPTXPaFLOSV?  ♦ NOFL02«A 
Flf  LI)/=VEPTX2  ♦ TOTVT?*? 

TOPla  FiELO?  ♦ N0FLU2»5 

NVxroTVT?«2 

NF=NOFLU?*A 

REAlHMAPTAM.FNns'.O)  (CATNAM(  II  ,I8|,NCaT)  , (CLSNAM(I)  *Ib1,N0CLS?)  , 
(SUh  <0 (I ) « la) ,NOCLS?) , (SUHNAM(I) , |al ,N0SUB2) , 

( APWAY (H.DSV2-1 • I ) ,lai ,NF»  » 
(AMMAY(Vf.RTX?-l*l).!al,NV)  ♦ 

(SLMIAT ( I) ,Ia) .NOSUM?) , (CLSSURC I) *lal,N0$UR2> 

. (KAfNOMI  .lal.NOCLS?)  • (KFPPTS  ( I ) * I«  1 ,N0SUG2) 

GO  TO  65 
60  STOP-1 

C* 


Iff’i 


SEToliTO 

SETOiaeo 

SET01390 

SFTOIAOO 

lITSbl 

5f T01A30 
SFTOIAAO 
SFTOIASO 
SFT0i*60 
SFTOlATO 
Sf TOIAHO 
SFTOIANO 

Sf.  I01‘'/“ 


riLt  SETUPS 


e» 

# 


00  READ  CONTROL  CAROS  AND  TEST  FIELDS 


,0SV3i 

IW03' 


■ TOPI 
FL0SV3 
'ION  FC 
LD3  ♦ 


ROO 

200 

000 


RESERVE  room  FOR 
VCRTA3-F1EL03  ♦ 1 
VniM  ■ TOP  - VEHTA3 
CALL  REniF  M array «KoSV3» 
• GTUN  ' 


TEST  FIELDS 


IF.S 

"^8 


NAME 


c« 


niF  M array JFL0SV3) I ARRAY <F1EL03» lAR 

LOJ^Lf loj TOR?«T0PJ 
0*)T  SAven  TRAINING  FIELDS  AND 
TOP  .NE.  0 » UOfO  .200 


ARRAY (VERTXSItVOIMt 
■‘LEt 


TOP2«VkRTx:i*TOTVT 
1F<N0F  ■ 

WRITE 
IF  ( S 

PRINT  OUT  SUPERVISOR  INFORMATION 


TEST  FIELDS 


c- 

c» 


FJTMRSKY 

FIEMPTRS 

FtTMRSVA 


.fO.  1) 

GO 

TO 

80 

.EQ,  2) 

60 

TQ 

60 

,EO,  3) 

60 

TO 

60 

TEST  FOR  FISMFR 
IF(TmRSKY.FQ.A)  GO  TO  RO 


RO 


ROO 

C« 

C* 


C* 

C»  . 
ROl 


'ri 


NOTHRS  > A 

CONTINUE 

WRITE(6«Ri9) 

FORMAT a???YOU  HAVE  SELECTED  THE  FOLLOWING  OPTIONS! • / 


ALL 


CAL 

M(  ‘ 

M 


TaRLAR(MUNIT 
TcMAPTAP 
E *■  MUNIT 


. MTAPE) 


WRITE (6tB0l) 

no 


MTAPE  . MUNIT  f NFILE 

•P.<0CESS  The  CLASSIFICATION  RESULTS  FROM  HAPTAP  I 


nCATI 

) . UNIT*  • IS,  • , FILE*  « IS  > 


FORMAT ( 

* AN,  • . 

iF  (NOThRS  ,F«.  A) 

F (THWSKY  .FO.  1)  w« 

F(FMPTHS  .Eu.  2)  WHl _ 

F (THHSVA  .to.  T>  WRITE(6,RIR) 


MTF  (6,R03> 
MTF.  (6, RCA) 
[Tf (N,R05) 


TEST  FOH  fisher 
IFITHRSKV.EQ.AI  wRITE(6,817> 


continue 


IF 


(6,606) 


IF 

( 

TST)^f.y 

,F9.  1 

) 

IF 

( 

statky 

.E'J.  1 

) 

IE 

( 

PCf OsY 

.EO.  1 

) 

?••• 

C 


R27 

R2R 

R29 


(TRNKET.EU. 1 . ANO.OOTKEY.LE.n)  WRITE 
- - - - WRITF(6,«0«» 

wRITt(6,HlO) 

. _ W»ITE(6.6I2) 

F (NOMAP.t  J.O) WMI TF  <N,R2Q) 

F (PLTKFY.fJL.O) -^ITC  (N,R?i)  >» 

FCFILTFM.f'J.l  ) WStTE  (6,H?2) 

F (Of  SKtT.t  3.  n (b,«?3) 

F (CRHfEY.F  ). I > -PI Tf  (b.H2A)CROP 

CODE  ADDED  NOV  13,  IPTR  TO  INCLUDE  LIST  PROCESSING 

IF  (noT*'FY.EQ.O)  GO  TO  R2 
WPt  TF 

,(-(lTF  6TUNIT,GTF1LE,  AIUN1T,AIFILE»PPUN1T,PPFILE 

IF  (NaMF.CT  .FiJ.HLANKJGO  10  82 
WPITFIN.WPT) 

^»*nMN,HY0)  NAMfCT 
WPlTF(*,,MTn  AL»M  1 ) ,A(  P(?) 

F ikhati'o  List  Processing  option  selected  •» 

FOPMAf  (///,^X,  • NUPMEPS  OF  (iMOUHD  TRUTH  , Al,  AND 
• OISCPIMlNilOP  UMTS  AM)  files  APE  AS  FOLLOWS  •» 

FOPhaI (///,?X,6l?», IS) » 


?!8 

an 


790 


;to 

•TO 

•Toi 

SFTOIRAO 

SEToisSO 

SETO1H60 

setoUto 

SETOlRRO 


lf!8 

,SFTO 
SETO 
SETO 
Sf  TO 
SETO 
Sf  TO 
StTO 
SETO 
SETO 


690 

900 

910 

920 

930 

RAO 

9S0 

960 

970 

980 

990 


SET02000 
SCT02010 
SfT 02020 
SET02030 
SET020AO 
SET020S0 
SET02060 
SET02070 
SET02080 
SET02090 
SFT02100 
SET02110 
SET02120 
SET02130 

setoMao 

SFT02150 
SET02160 
SFT02170 
Sf  T021H0 
Sf  T02190 
SFT02200 
Sf T02210 
SET02220 
SET  02230 
SFT022A0 
SET022S0 
Sf  T02260 
Sf T02270 
StTO?280 


A 


FILE  SETUPS 


SELECTED  CAT^GOHY  NAME  FOR  LIST  IS 
. alphas  are  ».2F1C 


S30  FORMAT!///. bX.* 

83J  format (///.SX«*  BIAS  CORRECTION 

AOS  FOt  'AT (TlO. 'AMPLY  NO  THRESHOLDING') 

A04  FORMAT! no. 'APPLY  CHI  SQUARE  THRESHOLDS') 
805  FORMATmo. 'APPLY  EMPIRICAL  THRESHOLDS') 
80f  FORMATCIO, 'OUTLINE  THE  TRAINING  FIELDS') 
808  FORMATCnn, 'OUTLINE  THE  TEST  FIELDS') 


'.A4) 

.8) 


SET02290 
SET02300 
SET02310 
SET02320 
SETU2330 
SET02340 

. . _ . _ SET02350 

810  FORMAT(T10«'PRInT  OUT  THE  STATISTICS')  SET02360 

812  FORMAT  mo. 'PRINT  THE  GROUND  TRUTH  PERFORMANCE  SUMMARIES  BY  FIELO'SET02370 
* ) SET02380 

C-  SET02390 

817  format ITIO. 'APPLY  FISHER  F-0ISTRI8UTI0N  THRESHOLDS')  SET02400 


818  FORMATmo. 

819  FORMAT!//// 

820  format !T10.' 

821  F0RMaT!T10.' 
•U8CL ASSES' ) 


ItlS 


c-  . ^ _ SETO; 

APPLY  USER  INPUT  THRESHOLD  VALUES')  SETOl 

SET02430 

NOi  display  a CLASSIFICATION  MAP')  SET024AO 

iSPL"Y  the  histograms  of  the  QUADRATIC  FORM  FOR  ALL  SSET02A50 
_ SET02460 

822  format (TlO.'PPrFuRM  SPATIAL  FILTERING')  SfT02A70 

823  format  !T10. 'EXCLUDE  PIXELS  IN  THE  DESIGNATED  AREAS  FROM  CLASS1FICASET02480 

*TION  SUMMARIFS')  SET02490 

824  format !T10. 'PRINT  THE  INTENSIVE  TEST  SITE  SUMMARY  REPORT  FOR  ' «A6)SET02SOO 
825  format  !T10. 'PRINT  DOT  DATA  PERFORMANCE  SUMMARIES  FOR  DOT  DATA  FROSET02510 


C* 

_826 

C 

82 


IM  FORTRAN  UNIT.I3.'  .FILE  NO,  '.13.  ' .TAPE  <OR  FILE)  '.  A4) 
FORMAT!  TIO.  'OUTLINE  THE  DOTS  ON  THE  CLASSIFICATION  MAP'  ) 
CONTINUE 


C* 

C 

c*** 

c 

c 

c 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

87 


CALL  MHTFLi)!ARRAY!FLDSV2) .ARRAY !VEHTX2) .N0FL02. 1 .CLSNAM.SUBNAM) 
TF!NOFLn3.LE.O. and. N0FLD4.LE. 0)60  TO  85 
IF!TSTKEY,EQ,1) 1KS2 

IF!TSTKEY.EQ.l )CALL  WRTFLO (ARRAY 1FLDSV3) .ARRAY (VERTX3) .N0FL03.IK* 
* Cl SNAm.SUmNAM) 

IF(DESKEY.FO.l) IK=3 

IF!DESKeY.EQ.l)CALL  WRTFLO (DESSAV.DESVER.N0FLD4. IK.CLSNAM.SUBNAM) 
8S  CONTINUE 


COOL  ADDED  NOV  13.1978  TO  INCLUDE  LIST  PROCESSING 
IF  (OOTKEY.EO.O)  GO  TO  86 

MAKE  SPACE  AVAILABLE  IN  ARRAY  FOR  DOT  DATA  INFORMATION. 
INCLUDING  inon  SCRATCH  LOCATIONS  FOR  TEMPORARY  STORAGE  OF  DOT 
DATA  RETURNED  FROM  SUOH,  ROOOTS. 


MOVE  THE  TEST  STORAGE  ! TSTSAV.TSTFuO.TSTVER 
THE  INPUT  ! MAPTAP  ) TRAINING  FIELD  STORAGE 


IF  ! NOCAT  .LE.  .0  ) GO  TO  108 


) TO  OVERLAY 


CONTINUE 
NTSAV  = FIELD3  - FLOSV3 
MTFLD  s VERTX3 
NTVER  3 TOTVT3 
NMOVE  3 NTSAV 


c* 

c 

c* 


90 


fromao 
DO  90 
It  = I 
APPAY! I ) 
FROMAO  3 


- FIEL03 
“ 2 

NTFLO  ♦ NTVER 


FL0SV3 
Isl, NMOVE 

3 ARRAY (FROMAD) 
FL0SV3  ♦ II 


RESET  the  TEST/OESIG  FIELDS  STORAGE  BASE  ADDRESSES  IN  ARRAY 


FLnSV3 
FIFI.D3 
VERTX3 
TOPI  3 


* 1 

3 FLOSV3 
a FIELD3 
VERTXJ  ♦ 


♦ NTSAV 

♦ NTFLO 
UTVER 


FLCSV2 

FIEL02 


’'OPl 

TOPI 


♦ 4 


SET02520 
SET02530 
SET02540 
SET02550 
SET02560 
SET02570 
SET02580 
SET02590 
SET02600 
SET02610 
SET02620 
SET02630 
SET02640 
SET 02650 
SET02660 
SET02670 
SET02680 
SET02690 
SET02700 
SET02710 
SET02720 
SET02730 
SFT02740 
SET02750 
SET02760 
SET02770 
SET02780 
SET02790 
SET02800 
SET02810 
SET02820 
SET02R30 
SET02840 
SET02850 
SETOcbbO 
SET02870 
SET02880 
5FT 02890 
SET02900 
SET02910 
SET02920 
SFT02930 
SET02940 
SET029S0 
SET02960 
SFT02970 
SET02980 
SET02990 
SET03000 
SFTD3010 
SFT03020 
SFT03030 
'ET03040 


FILE  SFTUP3 


C» 

c« 

86 


C* 

C» 


VERTX2 
TOPa  a 
NOFLD2 
NOTPFO 
PCT103 
RETURN 


a TOPI 
VEPTX2  ♦ 
> 209 
- 209 
■ TOP2 


♦ 5 

500 


99 

101 


102 


103 


C* 

105 

C* 

106 

C* 

C* 

C* 

107 

401 

C* 

C* 

c* 


310 

340 

350 

320 

200 

201 


NOTRFOsNOFLOa 

IF  (TSTkEY ,E0, 1 ) NOTPFO«NOFL03 
PCTSZ=NUTRFO«NOSUP2 
lF(PCTS7.LE.(TnP-T0P2)»60  TO  106 

MOVE  TEXT  FIELD  INFO  SO  NO  GAPS  IN  ARRAY  IF  STORAGE  IS  NEEDED 

lF(TSTKtY.EO.o)GO  TO  105 

MUST  TRAINING  FIELD  INFO  BE  KEPT  IN  CORE 

IAD=FLDSV2-1 

IF(TRNKEY.EQ.I) IA0»T0P1-1 

1BD=FLDSV3-1 

NFa4*N0FL03 

TIMEaO 

DO  101  lal.NF 

APRAY(lAD4l)=ARR4Y(IflO*I) 

lF<TI*^t.GT.O)GO  TO  102 

IA0=IAD*NF 

IB0=FIELD3-1 

NFs5*N0FL03 

TIME=TIME»l 

GO  TO  99 

1F(TIME.E0.2)G0  TO  103 
1AD=IA0*NF 
IBn=VERTX3-l 
NF=T0TvT3*2 
TIME=TIME*1 
GO  TO  99 
CONTINUE 
FLDSV3=T0P1 

IF(TRnnEY.EO.O)FL05V3s1 
FIELD3--rLi)SV3  ♦ 4»N0rL03 
VERTX3=FIELU3  ♦ S«^NOFL03 
TOP2  = VERTX3  ♦ 2*TOTVT3 
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IF  ( PCTSZ  .GT.  ( TOP-TOP2)  ) 


GO  TO  508 


PCTI03  = TOP2 

SET  UP  FIELD  ARRAY  FOR  TRAINING  FIELDS 


IF(  OOTERH  .GT.  0 > 


RETURN 


C 


IFITSTKEY.EO.O. OR. TRNKEY. £0.1)60  TO  400 
CONTINUE 

SET  FLDKEY 


IFITSTKEY.NE.DGO  to  340 
FLDKEY=1 

no  310  I=1.N0FL03 

NS  = FL0SV3-1*3*(I-1)*4 

IF(ARWAY(NS) .EO.OIGO  TO  320 

CONTINUE 

GO  TO  200 

FLPKEYsl 

no  350  I=1.N0FL02 

NS  = FLI>SV2-1*3*  ( I-l)*4 

IF  (ARRAY (NS) .£0.0)60  TO  320 

continue 

RETURN 

FLOKEYsO 

RETURN 

nOTKEY  = NOCAT 
FLOKEY  = 0 
RETURN 


ERROR  ROUTINES 


SET03050 
SET03060 
SET03070 
SET030SO 
SET03090 
SET03100 
SET031 

SET03L 
SET03140 
SET03150 
SET03160 
SET03170 
SET03180 
SET03190 
SET03200 
SET03210 
SET03220 
SET03230 
SCT03240 
SET03250 
SET03260 
SET03270 
SET03280 
SET03290 
s|T03300 
SETO33IO 
SET03320 
SET03330 
SET03340 
SET03350 
SETC3360 
SET03370 
SET03380 
SFT03390 
SET03400 
SET03410 
SET03420 
SET03430 
SET03440 
SET03450 
SET03460 
SFT03470 
SET03480 
SET03490 
SET03500 
SET03510 
SET03520 
SET03530 
SET03540 
SET03550 
SET03560 
SET03570 
SET03580 
SET03590 
SET03600 
SET03610 
SET03620 
SET03630 
SET03640 
SET03650 
SET03660 
SET03670 
SET03680 
SET03690 
SET03700 
SET03710 
SET03720 
SET03730 
SFT03740 
SET03750 
5f  T03760 
SET03770 
SET03780 
SET03790 
-SEI03rtOO 


'j>,i 


FILE  SETUPS 


50«  WRITE  (6»5044)  OIFF 

S044  FORMAT  (/////5X. •••••••  0ISPLAT/SETUP3  - CORE  OVERFLOW  ITOP- 

1 execution  terminated  •••••••/IHI) 

CALL  CMERR 

108  WRITE  (6.109) 

109  FORMAT (/////5X,***»  CLASSIFICATION  BY  CATEGORY  (ON  MAPTAP  ) 

" “ HOT  DATA  •••*  / SX. 


SET03810 
SET03820 
SET03835 
TOP2)  SETOaOAd 
SET03RSQ 


C* 

C« 

e: 

c* 

c» 

c* 

112 


1 REQUIRED  IN  ORDER  TO  PROCESS  THE  DOT  0ATA~  *••*  / SX. 
2RF0RMANCE  summaries  WILL  NOT  BE  OUTPUT  •••*  ////  ) 

GO  TO  112 

ERROR  RETURN 


IS 


EI0386g 


SET0387 
SET03880 
DOT  PESET03890 
SET03900 
SET03910 
SET03920 
SET03930 
SET03940 
SET03950 
SET03960 
SET03970 
SET03980 
SET03990 
SET04000 
S|t04010 
SET04020 
SET04030 

.•.•.•.•.•.•.•.•.•.•.•.•.•.•.•.•.•.•..•*SET04040 

SET04050 
SET04060 

internal  ROUTINE  TO  FIND  RECTANGULAR  COORDINTES  FOR  TRAINING  FIELDSET04070 


MAX.  NO.  OF  DOTS  EXCEEDED 


ERROR  IN  OOTFILE  - RESET  DOTKEY  AND  TRNKEY  — 


DOTKEY  * 
TRflKEY=0 
RETURN 

C* 

C» 

c*.».*.*.*.*.*. 

c* 
c* 
c* 
c« 


410 


20 


c* 


CONTINUE 

SET04080 

SET04090 

I3»l 

SET04100 

1PT=1 

SET04110 

DO  20  Is1,N0FL02 

SET04120 

SAMSTH  = lOOOOO 

SET04130 

SAMtNO  = 0 

SET04140 

LINSTR  = 100000 

SET04i50 

lineno  = 0 

SET04160 

NS  s FLnSV2-l*4*(I-l)*4 

SETQ4170 

SET04180 

NV  = ARRAY (NS) 

NS  = FIEL02-1.S* ll-l)*5 

SET04190 

ARRAY (NS)  = fPT 

SET04200 

IPT=1RT*NV*2 

SET04210 

IE=IH*NV-1 

SET04220 

no  410  J=IR.IE 

SET04230 

NS  = VEHTX2  -1.1.(J-1)*2 

SET04240 

SAMSTR  = MIN0(SA'1STRfARRAY(NS)) 

SET04250 

SAMENO  = MAXn(SA-'FND.ARMAY(NS)  ) 

SET04260 

NS  = VEHTX2-1*2. (J-l)*2 

SET04270 

LINSTR=MIN0( LINSTR. ARRAY (NS) ) 

SET04280 

LINENOsMAXO (LINENO. ARRAY (NS) ) 

SET04290 

CONTINUE 

SET04300 

NS=FIELD2-1*1*(I-1)*5 

SET04310 

ARRAY (NS) sLFNSTH 

SET04320 

NS=FIELn2-1.2.(I-I)*S 

SET04330 

array (NS) sLINENO 

SFT04340 

NS=FTEL02-1.3*(I-1)»5 

SET04350 

ARRAY (NS) sSAMSTR 

SET04360 

NS=RI£U)2-l*4* ( I-l)«5. 

SFT04370 

ARRAY (NS) sSAMEND 

SET04380 

IR=IEM 

SFT04390 

CONTINUE 

SET04400 

GO  TO  401 

SETU4410 

END 

SET04420 

SET04430 

nnn 


FILF:  TINOPM 


function  TlN0HM(flLPHA,lFLA6> 

OlMFNSTON  A(3).B(3) 

DATA  A/,tnn32«<..802853»2.?»l5517/.B/.0010308» 
1 1.432788/ 


approximation  to  inverse  normal  distribution 


1 


IFI.NOT. (ALPHA. GT.n.. AND. ALPHA. LT.l.) ) IFLAG=1 
VsALPHA 

IF(X.6T..S»  X=l.-X 
»s«;ORT(-2.*4L0fitxn 

TINOfiM=X-(A(3)*X*(A{2)*X*A(l»))/(l.*X«(8(3)*X*<R(2)4X«  B(l» ) ») 
CALL  OV(-«FL(I) 

IF(I.FO.l)  C-0  TO  1 

IF( ALOHA.LT..5)  TlNOPMa-TINOPM 

RETURN 

IFLAOsl 

RETURN 

FNO 


TIN.OOOlO 

TIN00020 

TIN00030 

TIN00040 

TINOOOSO 

TINOOONO 

TIN00070 

IIN00080 

TlNOOORO 

TINOOIOG 

TINOOllO 

TIN00120 

T1N00130 

TIN00140 

TIN00150 

TIN00160 

TIN00170 

T1N00180 

TIN00190 
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13.  DATA-TR  PROCESSOR 


FILE:  OATATR 


SUBROUTINE  OATATR(ARRAY«TOP) 

IMPLICIT  INTEGER(A-Z) 

REAL  BIASaON  BMAT(A80)«  HAxd6>f  MlN(16)t  C0N(16)f  C0NMIN(32) 

REAL  AHAX(16)«  AMIN(16)»  AC0N(16) 

DIMENSION  ARRAY(TOP).  MAXPT<30J.  FILHIS(1616) 

DIMENSION  HORinS)  t HDR2(15)  • COMnT(IS)  t INDATE(3) 

INCLUDE  C0M9KI.LIST 
INCLUDE  C0M^K9»LIST 
INCLUDE  C0MRK6»LIST 

COMMON/INFORM/NOCLS2»NOSUB2iNOfET2,VARSZ2»TOTVT2.NOFLD2* 

* AVAR2.C0VAR?»CLSiD2.SUBN02.SUBDS2»FLDSV2.VERTX2» 

*.  FETVC2(30» .SUBVC?(7S) ,SU«PTH(75) .CLSVC2(60) . 

* KtPPTS(60»  ♦N06RP.'6RPNAM(60)  f6RPDEX(6l)  . 

* GHPChK (61) »GR0UP9<12A) 

C0MM0N/GL08AL/HEAD(63) .MAPTAP,oATAPE*SAVTAP.8MFILE*BMKEYt 

* hisfil.hiskey,trfoRm*eriptp.erpkey.mapunt.nofile» 

* DRUMAD.OPMwOS.PAGSIZ.OATFlLtSTAFlLf ASAVtASAVFL 

* .NHSTUN.NHSTFIfSCTHUN.MAPFiL 

* .D0TUNT.00TFI(,»NCHPAStTRNSFL,8MTRFL,HISTFL»PCHUNT» 


CROUNT . PHTUNT .RAND  1 0 
DATA  TRANSFORMATION  COMMON  BLOCK 


SEND 


COMMON/TR8LCK/OUTFMT.NOFEAT,FLoINF(6) , 

DIMENSION  VERTCS<2.11) 

DATA  BLANKS/*  •/ 


FETVEC(30> 


RESCALING  method  IS  DETERMINED  IN  SETUPfl  : 

SCAFLG  = I » RESCALE  BY  HI^yTOGRAM  METHOD 
SCAFL6  * 2 » RESCALE  BY  STATISTICS  METHOD 
SCAFLG  = 3 . RESCALE  WITH  UsER-lNPuT  SCALING  PARAMETERS 

IF  THE  FLAG  RESCAL  IS  ZpRO.  NO  RESCALING  OCCURS 


DO  10  1=1. IS 
IPL3  =1*3 
HDRKl)  = hEAD(lPL3) 
IPL29  = I ♦ 29 
HDR?(I)  = HEAD(IPL29) 
10  COMNT(I)  = BLANKS 


INOATE(I)  = HEAD(22) 
lNnATE(2)  = HEAD(23) 
INDATE(3)  = HEA0(2A) 


CALL  SETUP0{BMAT.LCOMB.BmTRI6.pEROUT.MAXPT,ARRAY,LAM. 

* SCAFLG  , TOP.  TRANSF.  RESCAL*  BIAS.  ADUNUM,  CONHIN,  NPUN.NF  ) 
IF  (RESCAL. E(J.O)  GO  TO  50 

IF  (SCAFLG. EQ.l)  GO  TO  30 
IF  (SCAFLG. EQ. 2)  GO  TO  20 
IF(  SCAFLG  .EO.  3 ) 

• CALL  SETREM  ( CONMIN,  CON,  MIN,  AOONUM,  LCOMB  ) 

60  TO  50 

IF  RESCALING  BY  THE  STATISTICS  METHOD,  APPLY  TRANSF OPMAT ION  TO 
stats  ( MEANS.  COVARIANCES  ) » OBTAIN  TPAUSFORmLO  MAX  AND  MIN 
USING  TRANSFOHMEO  STATS  . 


DATOOOIO 
DAT00020 
OAT00030 
OATOOOAO 
UATOOOSO 
DAT00060 
DAT00070 
UATOOOSO 
UAT00090 
DATOOlOO 
DATOOllO 
OAT00120 
OAT00130 
DAT00140 
OAT00150 
OATOOIGO 
DAT00170 
UAT00180 
OAT00190 
DAT00200 
OAT00210 
OAT002P0 
OAT00230 
DAT002A0 
OAT00250 
DAT00260 
OAT00270 
OAT002B0 
DAT00290 
OAT00300 
DAT00310 
DAT00320 
OAT00330 
OAT00340 
UAT00350 
DAT00360 
OAT00370 
DAT00360 
UAT00390 
(JAT00400 
OATU0410 
OAT00A20 
UAT00430 
UAT00440 
UAT00450 
OAT00460 
L»aT00470 
DAT00480 
OAT00490 
DAT00500 
OAT00510 
UAT00520 
UAT00S30 
OAT00540 
UAT005S0 
OAT00560 
OAT00570 
DATOObSO 
UAT00590 
OAT00600 
UAT00610 
OAT00620 
UAT00630 
UAT00640 
UAT00650 
OATOOhGO 
DAT00670 
OAIOOhRO 
uAT  OUhVO 
OAT00700 
OAroo/io 
I'AT  00720 
UAT00730 
UAT00740 
OA  I 007SO 
l;AT  00760 
OAT00770 
DAI00780 
OAT00790 


oo  nrt  r>n  rtnnnnnn  nrtnonnnnn 


FlLCt  DATATR 


20  CALL  KBTRAN  ( 8MAT*  LCOHBt  ApRAY*  LAM*  MAX*  MIN*  CON*  TRANSF  ) 


60  TO  50 


IF  RESCALING  BY  THE  HlSTOGRxM  METHOD*  OBTAIN  , _ 

— OF  the  transfohmeo  data 


MAX  AND  MlN  OF  EACH  COMPONENT 
< VIA  MAXMAT  ) AND  PERFORM  A 
DATA  ( VIA  TRHIST  )*  IN  ORDER 
PARAMETERS  * CON  AND  MIN  . 


THE  PREDICTED 


HISTOGRAM  OF  THE  TRANSFORMED 
TO  OBTAIN  THE  RESCALING 


30 


OATooeoo 

OATOOBIO 
OAT00820 
DAT00630 
OAT00840 
DATOOBSO 
OATOOH60 
OAT00G70 
OATOUSHO 
OATOOG90 
DAT00900 
OAT00910 
OAT00920 
DAT00930 
UAT00940 
UATUU950 
OAT00960 
OAT00970 

APPLY  transformation  TO  INPyT  DATA,  RESCALE  ( IF  OPTED  >*  APPLYDAT00980 
REJECTION  ( PEROUT  ) TO  DISTRIBUTION  OF  TRANSFORMED  DATA*  AND  DAT00990 


CALL  MAXMAT  ( AMAX,  AMIN*  ACON*  BMaT*  LCOMB*  MAXPT  ) 
CALL  TRHIST (ARRAY, AMAX* AMIN, ACON, BMAT *LC0MB*PER0UT* 
•filhis,top*lar,flonam*nc,vertcs*max*min,con, 

• BIAS) 


OUTPUT  THE  TRANSFORMED  DATA  ON  THE  FILE  * TRFORM 


IF  (LAR.EO.O)  GO  TO  60 


50 


CALL  LNTRAN( ARRAY, max, MIN*CON,rMAT, LCOMB, BMTR16,SCAFLG, PEROUT* 

► filhis,top*lar*flonam*nc*vertcs*  rescal,  bias* 

» NF  * NPUN  ) 

IF  (SCAFLG.EO.l)  GO  TO  30 


60  CONTINUE 

00  70  I»I,15 
IPL3  *1*3 
HEA0(IPL3)  « HDRKI) 
IPL29  3 I ♦ 29 
HEAD(IPL29)  s HDR2(I) 
IPL47  * I ♦ 47 
70  HEAD(IPL47)  3 COMNT(I) 


C 

C 


HEAD(22) 

HEA0(23) 

HEA0(24) 


= INDAT 
= IN0ATE(_ 
s INOATEO) 


'Ji 


WRITE  (6*80) 

BO  FORMAT!////////// 

return 

END 


lox*  soata-tr  completed  **♦•  //////) 


oatoiooo 

OATOloiO 

OAT0I02O 

OAT01030 

OAT0I040 

DAT0IU50 

OATOI060 

OAT01070 

DATOlOaO 

DAT01090 

OATOIIOO 

uATo)  no 

DATOl 120 
DAT01130 
DAT01140 
OAT01150 
OATOl 160 
0AT01170 
DATOl IflO 
DATOl 190 
DAT01200 
OAT01210 
DAT01220 
DAT01230 
DAT01240 
DAT01250 
DAT01260 
DAT01270 
OAT012HO 
DAT01290 
OAT01300 
DAT01310 
OAT01320 
OAT01330 
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Fiir:  kbtran 


c 


* 


2 


f OAT 

CliENO 

C 


SURROUTINE  KBTRaN 

( 8MaT«  LCOMB*  ARRATt  LAMt  MAX*  MIN.  EPS.  TRANSF) 


implicit  INTEGER(A-Z> 

REAL  TMIN.TMAX 

PEAL  MMAT(480).  MAX(16)«  HIN(16).  EPSU6) 
PEAL  C<a80)  « CC(ARO) . 0(16).  OlAr.(A80). 


8MEAN(900) 


INCLUOE  COMAKI.LIST 
INCLUDE  COM>^Kq»LlST 
INCLUDE  COM^iCA.LIST 
INCLUDE  CDMliKft.LIST 

COMMON/ INF0PM/N0CL52. NOSUB?. N0FET2.VAPS72.T0TVT2.N0FL02. 

AVAW?.CnvAR?,CLSI02.SUON0?.SUBnS2.FLDSV?.VERTX?. 
FETVCZnO)  .SUMVC2(7S)  .SUBPTW(7S)  «CLSVC2(60)  . 
KFPPTS(60)  .NOGRP,r>HPNAN(60)  .GRP0EX(6l>  . 

RRPCHK ( 6 1 ) . GROUPS ( I 24 ) 

dimension  HEDl  (IS)  .MED2<1S)  .DATE  (3)  .COMENTdS) 

EOUI valence  (HFOl  (1)  .HEAD  (4)  ) , (OATEd  ) .HEAD!??)  ) . 

(HED?d)  ,HEAO(30)  ) . (COPENT  (1)  .HEAD  (48)  ) 
COMMON/r5LOBAL/HEAD(63)  ,PAPt AP.DATAPE  .SAVTAP.aMFlLE.BMKFY. 

hisfil.hiskey.ibform.epiptp.eppkey.hapunt.nofile. 

DPUMin.DRMwDS.PAGSIZ.nATFIL.STAFIL.ASAV.ASAVFL 
.NmsTUN.NH«;TFI  .SCTRUN.PAPFIL 

.OOTUNT.ODTFIL.NChPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 
rwOlJMT.PRTUNT.HANOIO 
TPANSFOWMATION  common  block 

C0MM0N/TWPLCK/0UTFMT.N0FEAT.FLDINF(6) . FETVEC(30) 


niMFNSlON  rOVHD2(lS) 

DIMENSION  APPAYd) 

DIMENSION  NSdB(75) 

DATA  CDvHD?/'...  • , ‘TRANi , »SF0R' . 'MED  • . 'STAT • » • ISTI • ♦ *CS 
•/.  hLaNks/'  •/ 


compute  TPANSFopmFD  means  for  FACH  SUBCLASS 

DO  in  i=f),)s 
m C0VHD2(1)  = planks 
DO  ?fi  T = l.r.nsUS2 
IPPsSU^^US?*!-! 

?l\  NSII«(1)=AHRAY(IPP) 

I,  7 = AVAR? 

K = i 

no  30  I=1.N0CLS2 

CALL  MATVt C(ftMAT.APPAY (L2) »8MEAN(K) .LC0MB.M0FET2) 
LZ=LZ*NOFtT? 

10  K=K*LCOMH 

COMPUTE  TPANSFORmfo  COVARIANCE  MATRIX  FOP  EACH  SUBCLASS 
KK  = o 

KsCOVAO? 

K KK  s i 

riO  so  Tsl.wocd:? 

MULTIPLY  HMftT  HY  COVARIANCE  MATRIX 

CALL  MTMLS^ (DmaT. ARRAY (K) , C.LC0MH,N0FFT2) 
multiply  RF<^ULTINii  M4TWIX  hY  TRaNSPOSF  OF  8MAT 

CAI.L  MTMDAT (C.bmaT ,CC.LCUMH,NOFET2.LCOMB,0,ARRAY(KKK) ) 
DO  40  II  = l.lCnMR 
40  DMC,(KK*II)=D(TI) 

KKKrKKK* (LCOMh# (LCOMB* 1 ) ) /2 
KK=KK.Lf,0'iH 
KsK.VAPSZP 
SO  CONTINUE 

PRINT  TPANSFORfPD  COVARIANCE  MATRIX 

CVI  = (LCOMri*(LCOMH.l)  ) /? 

IF  (TPA^SF,FU.O)  60  TO  80 
DO  60  1 = 1.  IB 
TFMP  = COmknT(I) 
rOMFNT(I)  = C0VMD2(I) 

60  rOVMDPd)  = TFMP 

CALL  PRTCOV ( ARRAY ( 1 ) .PMFAN( 1) .CV 1 .LCOMB .NSUB d ) ) 


J3f 


KHTOOOIO 

KUT0O0|O 

KQT00030 

KBT00040 

KRT0005Q 

KBT00060 

KBT00070 

KBT00080 

KBTU0090 

KBTOOlOO 

KRTOOilO 

KBT00120 

COHOOOlO 

CUM00020 

COM00030 

COM00040 

CUMOOOSO 

COMOOOlO 

COM00020 

COM00030 

COMOOOlO 

CUM00020 

COH00030 

COM00040 

COM00050 

COM00060 


KBT00140 
KHT00150 
KHTOOIGO 
KHT00170 
K8T00180 
KeT00190 
KBT00200 
KbT00210 
KBT00220 
KPT00230 
KHT00240 
KBT002S0 
KBT00260 
KHT00270 
KBT002S0 
KPT002P0 
KPT00300 
KBT00310 
KBT00320 
Kf(T00330 
KbT00340 
KWT00350 
KPT003IS0 
KPT00370 
KHT00380 
KHT00390 
KHT00400 
K8T00410 
KPT00420 
KBT00430 
KPT00440 
KET00450 
KNT00460 
KhT00470 
KHT00480 
KRT00490 
KH  r OOSOO 
KHTonsio 
KHTOOS20 
KhTOOSlO 
KHTO0S40 
KPTOOSSO 
KHTOOM60 
KHT00S70 
KMT  00S80 
KHT  OOSRO 
KMT  OObOO 
KPTOOhlO 
KHTOObPO 
KPT00630 
KHT00640 


riLFi  KBTRAN 


no  70  tal.lS 
70  rOMENTU)  B COVHOgd) 

BO  CONTINUE 

CALCULATE  MINIMUM  AND  MAXIMUM  FOR  EACH  SUBCLASS 


no 

00 


lalfLCOMR 
jsi,  - 


M0CLS2 

7 * 


LC0M8 
ANCnEU  ♦ 
TO  90 


90 


IfS 

NEL  * 

MAX(T)  a RMt 
IF  <J.NF.l>  GO 
TMAX  a MAX(I) 

CONTINUE 

IF(  Mftxm  ,GF.  TMAX) 
M1N(I)  a MHF.AN(NEL)  - 
TF  (J.NE.l)  GO  TO  100 
twin  a MIN(I) 


♦ I 
LAM 


* DIAG(NEL) 


TMAX  a MAX(I) 
LAM  • OIAG(NEL) 


lOO 

CONTINUE 

IF(  M1N(I)  .1 

no 

CONTIMJE 

MIN(I)  a 

Twin 

MAX(I)  a 

T‘*AX 

fOSd)  a 

?S5. 

1?0 

CONTINU*-- 

OFTUHf 

ENO 

TMIN)  TMIN  a MIN(I) 


/(HAX(I)  - MIN(I) ) 


KBT00650 

KUI0O6OO 

KBT00670 

XHT006A0 

KBT00690 

KBT00700 

KBT00710 

KHT00720 

KHT00730 

OHT00740 

KBT00750 

KBT00760 

KBT00770 

KBTOO/80 

KHT00790 

KHT00800 

KPT00810 

KHT00a?O 

KBT00830 

KBT00840 

KHT008B0 

KBT008O0 

KBT00870 

KRT00880 

KBT00890 

KBT00900 


file  lntran 


r, 

r. 

c 

r 

? 

{? 

8 

r 

c 

c 

c 


c 

r 

c 

? 


SyjPOUTiNE  LNTO4N(IDATA«MA«.MlN»C0MtBHAT»LC0HB.BMTRIG*SCAFL6» 

* PFROUT.FlLHIS»TOP*LA«fFLt>NAM,NCfVEKTCS*  HESCAL*  BIAS* 

• NF  * NPUH  ) 


IF 

IF 


scaflg 

SCAFL6 


* 2 


IF  SCAFLG  « 3 * 


hescale  by  histogram  method 
rescale  by  the  statistics  method 
rescale  with  user-input  scaling  parameters 


NOTEJ  IF  THE  FLAGf 

•PERFORMEn.  HO* 
data  UISTRIBUT 
DATA  VALUES  . 


RESCal  t IS 
"VEw*  PEHOUT  ^ 

ON  PRIOR  TO  final 


ZEROt  NO  RESCALING 
IS  APPLIED  TO  THE 
OUTPUT  OF 


IS 


LNTOOOlO 

LNT00020 

LNT00050 

LNT00060 

iMiil 

LNT00< 
LNTOO 
LNTOO 
LNTOO 
LNTOO 


, TRANSFORMEOLNTOO 
TRANSFORHEU  ^NTQO 


implicit  INTFGER(A-Z) 

REAL  TMINM6)*  TMAXdO)*  MATOT  • 
PEAL  NEwmaX<1H)  . NEWMlNdo)  • SUM 
real  NXCON»PMl'''tPM«X,CMlN 
PfAL  HT4S(1»>)»  XCONdo)* 

REAL  MAX<Ih)«  “ 

PEAL  MlNSAVdn) 


MITQT 
f CUT 


CON (16) 

HAXSAVdb)  , 


XT(16>*  YREAL(16)t 
• PMAT(AMO)  f 
CONSAVdb) 


NPERl*  NPER2 
XXCONdG) 


DIMENSION  TOTOTS(16)  « PM1N(16)  • PHAX(16) 

nf  MENS  ION  HlSMUFdni)  ,VtPTCS(2.1  1)  ,FL(8) 
DIMENSION  lOATA(TOP)  « Y(8000)  . " 

DIMENSION  RADMINdG)  « BAUMAXdS) 


FILMIS(LCOMB.101  ) 

* HINCUT(16)  f MAXCUTdO) 


data 

Data 


DP/'  (•/.CP/»)  '/^COMMA/S*/ 
TTL/'TOTL'/ 


NCLUOE 

NCLUOE 

NCLUOE 

NCLUDE 


COMHKl ,L 
CDMmk9*L 
CDMRKR.L 
C0MRK6«L 


ST 

ST 

ST 

ST 


C OAT 


gSEND 
r***  CODE 

c 


COMMON/ INFOKM/moCL‘52.  NnSUB?»fgOFET2.  VAWS22.  Tut  VT2.NDFL02t 

• AVAP?,CnVAR2.LLSir)2,SUDN02»SUHnS2*FLDSV2«VEPTX2« 

• FETVC2(30)  .SU-3VC/(7S)  .SUPPTR(  /S)  tCLSVC2(60>  . 

• Rt  PPTS  (bO)  .NO'oPp»0PPNAM(60)  *GRPUEX  (61)  » 

• f).gPCHK(bl)  «GPui)PSd2<*) 

dimension  hEOI  (IS)  .H£U/'(  IS)  »f)ATE  ( J)  «C0mEnT(15) 
equivalence  (Mt  1)1  ( 1 ) .HEA[)(r)  ) . (DATE  ( I ) .mEAD(22)  ) » 

2 (HtO?  ( 1 ) ,mEA  ' ( i'J)  ) . (COMEnT  ( 1 ) tHEAO(AS) ) 

COMMON/GLOBAL/hK  ftO(bJ)  .•‘U'-'TAP.uATAOKtSAVTAP.hMF  ILEtBMKEYt 

• Ml  SFIL*HI  SKI;  Y.  ThFuwm.ErIPTp.EPPKEY  t MAPUNT«NOFILEf 

• DPUMflO.OMM-OStPAGSI/. JArFIL»Sl AFIL. ASAV» ASAVFL 

• tNHSTUN.NHSTF  I tSCTWiINtMAPC  IL 

• .nOTUNT.O;)TFlL.NCHPAS.TRNSFL«BMTRFL»HlSTFL»PCHUNT» 

• CPO'JNT«PPT(iNTtWANOIO 

A TRANSFOkMATION  COMMON  MLOCK 

COMMON/TkHLCK/OUTFMTtNUFtATtFLDINF(6)  t FETVECOO) 


ADDED  JAN.  15tl979  TO  ALLOW  MULTI-FILE  OUTPUT 


C 

C 

c 

c 

c 

c 

c 


c 

c 


rewind  trform 

SKIP  * nf  - 1 

CALL  FSFmFl(TWFOPM.SKIP.ISTAT) 

IF  (RESCAL. EO.O)  GO  TO  SO 

CHECK  FOP  rescale  FACTORS  INPUT  BY  USER  ( SCAFLG  ■ 3 ) 
IF  (SCAFLG. NF.?)  GO  TO  20 


compute 

scaling 


THE  transformed  Data  max  • 
PARA--IE1EHS  » CUN  AND  MIN 


USING  INPUT 


10 


DO  1ft  KF*1.LC0MB 
MAX (kF)  » 2SS./ 
CONTINUE  • 


CON(KF)  ♦ MIN(KF) 


20  CONTINUE 


- 

-NTOO 
LNTOO 
LNTOO 
LNTOO 
LNTr 


90 


COMPUTE  TmE  output  HISTOGRAM  SCALE  FACTOR*  XCON 


_ roo< 

LNTOO’ 
LNT00«_ 
LNT0023Q 
LNT00260 
LNT00250 
LNT00260 
LNT0027Q 
LNT00280 
LNT00290 
LNT0030Q 
LNT00310 
LNT00320 
LNT00330 
LNT00360 
LNT003SO 
LNT00360 
LNT00370 
LNT00380 
LNT00390 
LNT00900 
LNT00910 
LNT00920 
LNT00930 
LNT00940 
LNT00450 
LNT00460 
LNT00470 
LNT00480 
LNT00490 
LNT00500 
LNT00510 
LNTOOS20 
LNT00530 
LNT00540 
LNTOOSSO 
LNT00560 
LNT00S70 
LNTOOSSO 
LNT00S90 
LNT00600 
LNT00610 
LNT00620 
LNTOftb30 
LNTUOb40 
LNT00650 
LNT00660 
LNT00670 
LNT006B0 
LNT00690 
LNT00700 
LNT00710 
LNT00720 
LNT00730 
LNT00740 
LNT00750 
LNTOO760 


^91 


O'*  r*"*  *>  o T r>T.no"*r»  onoo'*  o nrtnn  nnnnnrtrt 


FILE  LNTRAN 


00  30  KK«1.LC0M% 

XC0N(KK>b(M«X(KK)-M1N()SK)  )/60 

30  FETVC2<KK>*KK 

IF  (SCAFLG.EQ.I)  go  to  BO 


FOff  ST  AT 
S 

0 ...  . , 

INPUT  ♦ TRANSKOWMED 


fOR  STATISTICAL  OR  INPUT  SCALE  PAHA' 
iCALiNO  PAMAA'ETERS  ( MIN.  MAX  ..  CON 
)F  THESE  PARAMETERS  ON  THE  SECOND  Ai 


input  SCALE  PARAMETERS.  SAVE  THE  . iNITIAlj^ 


) FOR  Rt-INITIALI2ATI( 

AND  SUCCEEDING  FIELDS  TO  BE 

AND  RESCALED  ( IF  RtSCAL  GT  0 ) 


no  AO  I»I.LC0M8 
MAXSAV(I)  * SAX(I) 
MlNSAV(i)  » MlN(i) 
COw(l) 


AO  CONSAV(I) 


POSITION  THE  INPUT  OATA  FILE.  AND  READ  IN  THE  HEADER  RECORD 

50  continue  ^ ^ . 

CALL  TAPHDR(OATAPE.DATEIL) 

GO  TO  62 

bO  NE  ■ NE  ♦ I 

read  the  coordinates  ( VERTICES  ) OF  THE  FIELD  FOR  THE  DATA 
TO  HE  transformed  . 

62  LAM»LAREaO(ELDMAm,vEPTCS.Fl01NF .NO 
IE  (LAm.Eq.O)  CjO  to  920 
IE  (LAM.LT.O)  go  to  900 

FOR  statistical  OR  INPUT  SCALING  PARAMETERS.  INITIALIZE  THE 
scaling  parameters  max  . MIN  . CON  . XCON  FOR  THIS  FIELD 

IE  (RESCAL.EO.O)  go  TO  80 
sI.LCOmB 


70 

00 


DO  70  Ii 
MAX ( I ) i 
MIN( I » X 

CON(I)  X CONSAV(I) 
XCON(l)  X ( MAX (I) 
CONTINUE 


-•AXSAV  ( I ) 
MlNSCV(I) 


MiN(i)  )/eo. 


LNT0077 

i.S8s?r 

LNTOOBpO 

lntoobIo 
lntoobIP 
LNT00830 
LNTOOBAO 
LNTOOBSO 
LNT00B60 
LNT001470 
LNTO08BO 
LNT00B90 
LNT009PO 
LNT00910 
LNT00920 
LNT00930 
LNTO09A0 
LNT009S0 
LNTOO960 
LNT00970 
LNT00980 
LNT00990 
LNTOiopO 
LNTOIOIO 
LNT01020 
LNTUI030 
LNTOIOAO 
LNT01050 
LNT01040 


070 

080 

090 

00 


LN  . 

lnto 

LNTO 
LNTO 
LNT0_ 
LNTOI 
LNTOllAO 
LNTO 
LNT  ■ 

LNT 
LNT01180 
LNTU1190 


i8 

30 


I W A 

roiiso 

roIiGO 

roilto 


»00 

LNT01210 
LNT01220 


no  90  I=l.LCOMH 
MAXCOT (I  I » 0 
MINCUTU)  X 0 
NK>"1AX(I)  X 2SS.0 
XXCON(l)  X XCON(I) 

90  NERHIN(I)  s 0.0 

MTWAN  X 0 

NSAMPx (ELOINE(S) -ELOInE (4) ) /ElDINF (6) ♦ I 
IOIi/IxmOEE  AT*nSAMP 

IE  (101M.GT.T0P)  GO  TO  130 

TNsnC-1 

WPTTP  (fi.lOO) 

write  (f-  . n nin  DnAm,  IN.ELOINE  (6)  .ELOINE  (3)  « ( (OP.vERTCS  ( I .K)  .COMMA 
•VERTC>^  (?.K)  .CP4  .><  = 1 . IN) 

100  EOMMAT  ( 1 Ml  •IJO,  OF  SAMPLE  LlNf*/. 

•T12. •FlELDNAMt  VFptYcES  InC  INC  VERT ICES (SAMPLE .L INE )• ) 
no  EOP''AT(13X.A*..H*,I?.7x.lA.2A.l*.,2X.a(Al.I4.Al.lP.Al.2X)/ 

* S ( A 1 . 1 4 . A 1 « T4 . A 1 . ?X ) ) 

XUIMxlCOMH#NSAmM 

IE  (XniM.LE.6000)  GO  TO  150 


WRITE  (6.120) 


LNT01230 
LNT01260 
LNT01250 
LNT01260 
LNT01270 
LNT01280 
LNT01Z90 
LNT01300 
LNTOiBiO 
LNT 01 320 
I.NT01330 
LNT01390 
LNT01350 
LNT01360 
LNT01370 
LNT01380 
LNTO1J90 
.LNT01400 
LNT01410 
LNT01420 
LNT01430 
LNT01440 
LNTOIASO 
Lt^T  01460 
lnto 1470 
LNT01480 
LNTU1490 
LNTOlbOO 
LNTOISIO 
LNT01520 


or»or»r>  o r»f»r>r»r>r>  r»r»o  r>o  ooooo  ">  orton 


FILE  LNTRAN 


‘*".???5s*'ff:rsIS  T?5?  ?5oSS2?'’!5SMJ:55/’* 

no  w*^Ve^7l?i40) 

WMBER  OF  CH/^NNELS  TImES  number  of  samples  exceeds 

•00  ••••//) 

CALL  CMERR 

initialize  tape  reading  fow  this  field 

150  CALL  FLDINT(FLOInF,FETVEC#NOFEAT) 

LINES«(FL0InF(?)-FL0INF(1> )/FLDlNF(3)*l 

*»ite  header  record  on  output  file  ♦ TRFORM  . 

CALL  wRTHEOlLCO'iBtFETVCZtNSAMP.OUTFMT.TkFORM) 


EXLNT01530 

LNTf 

LNT 

lObLNTdj 
LNTO 


{>1. 

■ 

1)  » 


160 

170 


DO  170 
RA'IMAX  ( 
BAD»MN( 
PMlWin 
PHAX(!)  « 
TOTPTS(I) 
T 'll N ( 1 ) « 
TMAX(j)  > 
*00^(1)  * 
DO  160 


^L^OMB 
0 

0 

0 

» 0 

1.0E35 

-1.0E35 

XXCON(I) 


, J»1«101 
FiLHisd.JI  « < 
CONTINUE 


LSTLIN»0 

M>0 

lAO  M»M*l 

IF  (M.GT. LINES)  GO  TO  350 

READ  ONE  SCAN  LINE  OF  DATA  FROM  ThE  INPUT* TAPE 

CALL  LlHKPO(IDATA.ENDTAP) 

IF  (ENOTAP.NE.o)  60  TO  350 
IF  C^.NE.D  go  to  190 
ILINsFLOINF (1) 

GO  TO  ^0(t 

no  ilinsilin»floinf<3) 

200  CONTINUE 

DETERMINE  T‘^E  SAMPLE  INTERCEPTS  ON  THE  CURRENT  SCAN  LINE. 
;hICh  are  contained  in  the  OtSIREO  FIELD  BOUNDARIES.  PLACE 

THE  SAMRLt  Intercepts  in  fl  . and  the  number  of  intercepts 

IN  JU  • 

CALL  FOUNT  (VFWTCS-NC.FL.lLlN.NS.JJ) 
on  210  KsI.NSAmP 
DO  210  iHsj.LCOMB 
ZSAMPs ( lH-1 ) *NSAMP.K 
210  y(ZSAMP)»0 


NXCOV' 


255, /lOO. 


transform,  wESCALE.  and  histogram  each  DATA  SAMPLE 

00  130  K»1.NSAMP 
KP«(K-1)*EL  )INF  (><)  *FL0INF(A) 


KP«(K-1)*EL  )INF (> 
DO  120  JK*1,JJ,2 
JAPl  « JK  ♦ I 


IF  (KP.LT.FLIJK))  60  TO  330 
IF  (KR. GT. FL(JKR1 n GO  TO  llO 
DO  220  IclfLCOMb 
XT(1)»0. 


LNTO 

m 

LNTO 
LNTO 
LNTO 
LNTO 
LNTO 
LNTO 
LNTO 
LNTO 
LNTO 
LNTO 

t«8 

LNTO 
LNTO 
LNTO 
LNTO  , 
LNT01930 
LNT 01 940 
LNT01950 
LNT01960 
LNT01970 
LNT01980 
LNT01990 
LNT02000 
LNT02010 
LNT02020 


LNT02050 

LNT02060 

LNT02070 

LNT02080 

LNT02090 

LNTO2I0O 

LNTti2ilO 

LNT02120 

LNT02130 

LNT02140 

LNT021SO 

LNT02160 

LNT02170 

LNT021B0 

LNT02190 

LNT02200 

LNT02210 

LNT02220 

LNT02230 

LNT02240 

LNT02250 

LNT02260 

LNT((2270 

LNT022B0 


onon  ooo->r»  nnntr->nrtrfrtrtrt  -tnr»nn~t 


FILE  LNTRAN 


CALL  TRANSF  to  DO  A DATA  TRANSFORMATION 
CALL  TRANSF 

C (XT*  tlMATt  IDATA«  TOP*  I*  K*  LCOmB*  NSAMR*  BIAS) 
2?0  CONTlNtlE 

DO  3H0  I«l*LCOM8 
IFC  XT(h  .LT.  TMIN(I) 

IFC  XT(1)  ,6T  - - 


260 


C 

r 


r 

r 


GT.  TMAX(I) 

IF  HESCAI. 

UniNb  

STATISTICS*  OR  user-input 


) TMIN<I)  • XT(I) 
» THAXlI).  • XT  (I) 


0 NO  RESCALING  15  ARRLIEO 
NU  SCALING  RARARETtWS. DERIVE!)  FROM 


< SCAFLG-  1*  2* 


^eiImer'mIstogram* 


RISE  RESCALE 
k MI 
OR  3 ) 


IF  <RESCAL.GT*0)  GO  TO  260 


IF  transformed  DATA  IS, NOT  RESCALED  ♦ 

TEST  FOR  OUT-  OF  - RANGE  TRANSFORMED  VALUES 

SET  » 0 ANY  value  less  THAN  0*  OR  LESS  THAN  THE  NE«  MIN 

after  application  of  REROUT 

SET  « 255  ANY  value  greater  THAN  2SS*  OR  GREATER  THAN 
THE  NER  MAX  after  APPLICATION  OF  PtROUT 

[F  (XT (I» .LT.NPWMINCI) ) GO  TO  230 
IF  (xT(I).GT.NErmAX(I)  ) GO  TO  2<*0 


GO  TO  2S0 
230  1F(  MTRAN  ,£0.  0 ) 
XT(I)  « 0.0 
GO  TO  2S0 

2A0  IF  ( MTRAN  ,EQ.  0 ) 
XT(h  » 255. 

2S0  continue 


HAUmIN(I)  « RAOMIn(I)  * I 


BAOmAX(I)  « SADhAX(I)  « 1 


FOR  ThF  CUPWFnT  scan  LInE.  HISTOGRAm  THE  TRANSFORMED  DATA 
AND  STORE  the  TRANSFORMEU  DATA  INTO  THE  OUTPUT  ARRAY*  Y 

DPT  » XT(I)/NXC0N  ♦1,1 
TnTPT5(I)  » TOTPTS(I)  * 1 
IF(  DPT  .GT,  ion  OPT  «.101 
IF  ( OPT  ,LF.  0 ) OPT  « I 

FILHIS(I.OPT)  ■ FILHiSd.UPT)  ♦ I 
?S  » (1  -n  • NSAMP  ♦ K 

Y(Z«^)  » xTlIi  ♦ 0.5 
GO  TO  300 
CUNT  I NUE 

FOP  THE  CURRENT  SCAN  LlNE,  HISTOGRAM  THE  TRANSFORMED  DATA. 
STORE  The  Transformed  oaia  into  the  output  array*  y . 


IF  (XT(1) .LT.MlfMl) ) GO  TO  270 
IF  (XT(f),GT,MAx(f ) ) GO  TO  280 
YRF AL ( I ) =CON ( I) * ( X T ( I ) -M IN (I ) ) 


OPT  « < XT  (I) 


270 


IF  ( OPT  ,LE.  0 ) 
IF  ( DPT  .GT.  101 

GO  TO  2R0 

OPT  « ARS(  MIN-(I) 


MIU(I)  )/  XCON(I) 
OPT  « 1 


II 


) 


OPT 


10  - OPT 


s 

OPT  ■ lOl 
XT(I)  )/XCON(I) 

I 


2AO 


PMIN( I ) * PM1N( I ) 

IF (DPT. LE. 01  DPT»1 
YRE«L  <i)*o 

GO  TO  2V0  • ^ , 

DPT  « A8S(  XT(1)  - MAX(I)  )/XCON(I) 

DPT  » DPT  ♦ 91 


LNT02I 
LNT0(" 
LNTO 
LNT0_, 
LNT02 ■ 
LNT02i 
LNT02’i_ 
LNT02360 
LNT02370 
LNT02380 
LNT02390 
LN1 02400 
LNT02410 
LNT0242 
lntoIa:, 

LnT0244£ 
LNT02450 
LNT02460 
LNt0247g 
LNt024BQ 
LNT02495 
LNT02S00 
LNT02510 
LNT 02520 
LNT02530 
LNT 02540 
LNT 02550 
lntoHSo 
LNT02570 


LNT02610 
LNT02620 
LNT02630 
LNTOi 
LNTOl 
LNTOi 
* LNTO? 

, LNTOl... 
LNT02490 
LNT02700 
LNT02710 
LNT02720 
LNT0|730 
LNT02740 
LNT02750 
LNT02760 
LNT02770 
LNTi)|7»0 
LNT02790 
AND  LNT02800 
LNT02*)i0 
LNT02B20 
LNT02830 
LNT02840 
LNT02H50 
t NT02860 
LNT02870 
LNT02880 
LNT02M90 
LNT02900 
I.NT02910 
LNT02920 
LNT02930 
I.NT029R0 
LNT029S0 
LNT02960 
LNT02R70 
LNI029A0 
LNT02990 
LM03000 
LNTOiOlO 
LNT03020 
Lf^Toi030 

I uT  ii 


FILE  LNTRAN 


290 


300 


PMAKI)  ■ PHAXCIJ  ♦ 1 

li  hswyf^iiiii. 


7SAM*>*  ( I.l  )«r4SAMP*K 

YMEAL ( 1 ) 


OPT)*I 


YiZSA^PJ 

CONTlNyF 

‘ ■ 


» 0.5 


0/?fr;/Vy^»  r>. 

pf' )■<)(«, 


TO  310 
JKPl.GE.JJ) 

JNTjNUE 

3«0  CO'JTInoE 


110  IF 
;i?n  roi^iTi 
l3n  coNTii 


GO  TO  3A0 


IF (M.tu. LINES!  LSTLIN»-1 

OUTPUT  ONE  LINE  OF  TP*NSFO«HEO  DATA  ON  THE  OUTPUT  FILE 


LNT03050 

tsr, 

LNT0i99d 
LNTOJ 

LNTO' 
LNTOJ 
LNTQ3 


GO 


^wwTLN(Y.LSTLIN) 

0 l«0 


IF  PESC4LIN6  The  TPXNSFOt'ME 
0«  iJSFP-IvP'JT  SCALING  PAKArti 
apply  PEoni*T  ( OF  P0‘ 

DATA  OTSTPlHUTinN  - OH 


MlN  AND  COO 
SCALE  FACTOR 


r-  nr 

:»!is 


LNT(, 

LNTOJ 

TPFORMLNTO’ 

LNTO; 

ta?8 

lnto3 
LNTO; 


BY  EITHER  The  STATISTICAL 
REJECTED)  TO. THE  TRANSFORMED 


The  max.  and  scaling  PARAMETERS  LN 

< ALSO.  THE  HisfoGRAMLN 


AFTER  APPLICATION  OF  PtROUT 
XCON  ) . 


» V , 

m 


GET 


IF  not  rescaling,  apply  perout  to  The 
NER  max  and  min.  RE-HISTUGRAM  • AND  OUTPUT 


TRAN|F^RM|OjDATA. 


REVISED  DISTR. 


3S0  continue 

IF  (PEROUT. LE.O)  GO  TO  600 
IF  (SCAFLG.EO.D  GO  TO  600 
IF  (MTwAN.EO.1)  GO  70  GOO 

IF  (pescal.gt.o)  go  to  <*30 
NPERl  ■ FLOAT (PEROUT) /200.0 


I«l.LCOMH 
NPERl 


3G0 


00  4?0 
CUT  « 

SUM  « 0,0 
00  170  J«1 ,101,1 
IF  (SUM. G£. CUT)  GO  TO 
GO  T0_370 

■)  ■ SUM 


• FLOAT ( TOTPTS(l)  ) 


360 


•INCUT  ( I 

NtwMjNi I 

GO  TO  3R0 


) * (J-1)  • NXCON  ♦ 0.5 


FILHIS(I.J) 


3AS 


C 

C 


370  SUM  « SUM 
3A0  SUM  a u.o 
JalO! 

J»J-1 

IF  (SUM. GE. CUT)  GO  TO  390 
GO  TO  <*no 

3R0  MAXCUT(I)  a SUM 

NF.kMax(I)  a ( j - 1 ) • NXCON  . 0,5 
Oi)  TO  Mlo 

MOO  SUM  a SUM  ♦ FILHIS(I.J) 

TF(J.GT.I)  go  to  3R5 
4)0  continue 

420  CONTINUE 
GO  TO  b«0 


430  NPf.Pl  1 
NPLR2  > 

OSETaO 
IG  a 0 
IH  a 0 


PEROUT 

PEROUT 


.01  * 
.01  - 


.001 

.001 


LNTO 
LNTOI 
LNT03340 
LNT01350 
LNTU3360 

lntoSSto 

LNT033H0 

LNT0J395 

LNT03400 

LNT0J41O 

LNT03920 

LNT03430 

LNTU3440 

LNT034S0 

LNT034BO 
LNT03490 
LNT03SC0 
LNT03510 
LNT03520 
LNT03530 
LNT03540 
LNT03550 
LNT03560 
LNT03S7C 
LNT035B0 
LNT03S90 
LNT03600 
LNT03610 
LNT03629 
LNT 03630 
LNT03640 
LNT0J650 
LNT03660 
LNT03670 
LNT036BO 
LNT03690 
LNI03700 
LNTOJTio 
LM03720 
LNT03730 
LNTO 3 740 
LNT037S0 
LNT0J760 
LNT03770 
LNT03760 
LNT03790 
LNT03HO0 


file  lntran 


\i:t 

00.550,  I ■NlCOMS 

MjT0T«inTMT?n>*NPrni 

MlTOT*TOTPTS<i)*NPFH? 

IF  (PmInIII .GT.M4T0T)  GO  TO  khO 
GO  TO  460 
WE5ET  mIm  SM4LLEP 
440  CHINbPMIN(T) 


445 


4S0 

460 


CHlN«PMlNI 
j«in 
[•J-l 
6«I6*1 

F (CMlN.GT.'^ATOT)  56 
.FCCMIN.LT.MITOT)  IG» 
PSFT ■! 

1 i*'  * ’ ^ ‘ J > “ I < I > 

GO*1*0  >90 

F(J,Cm  . 1)  GO  TO  445 


iK. 


4S0 


Ji 


(PMlN(l> .LT.^ITOT)  GO  TO  470 
TO  490 
PESET  MlN  L4P6EP 

70  CmInbPMInTI) 

DO  mHO 


- »IN«CmIN*F1LH15( I , J) 

IF  (CmIN.LT.mITOT)  go  to  480 


IF  (CmIn.lt.  . . . ... 

IF(CMlN.OT.MATnT) 
M^NU)«m1N(  I)*iy**C0N(l) 

isFT«l 

GO  TO  490 
4P0  continue 
C CHECK  MA< 

*#9n  CONTINUE 

IF  (PMAAd). 

GO  TO  5?0 

r UE5ET  max  LApGEP 

son  CMlNsMMflXd) 

00  SI'I  j*92.101 


T.maTOT)  go  To  soo 


'UN  = CMIN-F  iLHiSd.  J) 

IF  (CMlf..r,T,M4T')T)  GO  fo  Sio 
IF (CMIN.LT.HITOT)  IE»IE-1 
»s^:t=i 

MA*  d )»MA*  ( I ) ♦ IE*XCONd) 

IE»r. 

GO  TO  550 


.LT.mitoT)  Gu  TO  530 


- - IHlSd.J) 

IF  (C'Mn.lI.mITOT)  go  to  540 
IF (CmIn.oT.maIuT)  IA>1A-1 
uSfeT«l 

MA<d)*MAXd)-lA*XCOW(I> 

I A>n 

GO  TO  550 

IF(J.GT.I)  go  to  535 

,0NT I nuE 

‘onTInuE 

IF  (PStT.FO.O)  60  TO  600 
00  “iTO  Is1«LC0mm 
»Cu|{  I » s (MAX  ( I)  -MlridJ  J/HO 
xxcf)K'(i>  » »roNd» 

CONd)  « ?SN.  / (MAXd)  - MlNdd 


510 

CONTINUE 

r OFSET  MAX 

SM4 

520 

IF  (PMAX( 

AO  TO 

550 

530 

CMIN* 

SHAX 

J«9l 

535 

J«J-1 

IA«I  A 

♦1 

CMlNa 

CM  In 

570 


5«0  IF  (NF.tO.l)  GO  TO  590 


LNT03810 
LNTOJaZO 
LNTQSttSO 
LNT03B40 
LNToStfSO 
LNT03860 
LNT0J870 
LNT03680 
LNTo5()90 
LNT039P0 
LNTO; 
INTO 
LNTOi  . 

mm 

LNT 03960 
LNT03970 
LNT03980 
LNT03996 
LNT04066 
LNT040I0 
LNT04020 
LNT0403Q 
LNT04040 
LNT04050 
LNT04060 
LNT04070 
LNT04080 
LNT04090 
LNT04100 
LNT04  10 
LNT04120 
LNT0N130 
LNT04140 
LNT04  ,50 
LNT04  60 
LNT04170 
LNTO^^ISO 
LNT04190 
LNT04200 
LNT04210 
LNT04220 
LNTOn|30 
LNT0n|4O 
LNT04250 
LNT04260 
LNT04270 
LNT0m2«0 
LNT04?90 
LNTU4300 
LNT0»*31O 
LNT04320 
LNT 04330 
LNT04 340 
LNT043S0 
LNT04360 
LNT04370 
LNT0438O 
LNT0M390 
LNT04<*00 
LNT04410 
LNT04420 
LNT04430 
LNT04A40 
LNT04ASO 
LNT  04<.60 
LNTOmnTO 
LNT04<t80 
LNT0N490 
LNT04S00 
LNT045io 
LnT0w5|0 
LNT04530 
LNT04540 
LNTO'^SSO 
LNT 04560 


1^10 


r»n  <rtr>  n r>  r>  or> 


FILE  LNTRAN. 


ORIGINAL  PAGE  IS 
OF  POOR  QUAU'l'V 


r 

r 


REWIND  TRFORM 
skip«nf-i 

CALL  FSFmFL<TRFORM,SKIP«ISTAT) 

MTRANsl 
fiO  TO  ISO 
*>9n  REWIND  TRFORM 
MTRANsI 
fiO  TO  150 
600  CONTINUE 
MTfiiAN«0 

IF  (RESCAL.EO.O)  go  to  710 
WRITE  (b»610)MF 

610  F0RMAT(/////  OUTPUT  FjlE  ‘t  13*  ///////  5Xt 

• TPANSFOkmED  values  rescaled  TO  A range  0 - 255 

IF  (SCAFLG.EO.1)  write  (6*620) 

IF  (SCAFLG.EO.P)  write  (6*630) 

IF  (SCAFLG.EO.3)  write  (6*6<»0) 

620  FORMAT ( 2AX*  ‘(HISTOGRAM  METHOD)'  / ) 

HO  format ( 23X*  ‘(STATISTICS  METHOD)'  / ) 

640  FORMAT!  20X*  ' ( IKPUT  SCALING  PARAMETERS)*  / ) 


LNT 04570 


LNT0<** 

LNT04f 


*...  ORIGINAL  TRANSFORMED  DATA  RANGE 
T32*  'MAX'  * T51*  '(  BIAS  )•  //  ) 


WRITE  (6*650) 

650  FORMAT!////  7K* 

• Til*  'MIN'  . 

00  660  M*l*lCOMB 

660  WRITE  (6*670)TMIN(M) *TMAX(M) ,B1AS(M) 

670  FORMAT!  5X*  F11.4*  lOX*  F11.4*  9X*  •(•  * F11.4*  IX*  ')'  / ) 


// 


WRITE  (6«6R0) 

6S0  FORMAT!/////  7x.  '■ 


LNT046?0 
LNTU4620 
LNT04630 
LNT04640 
LNT04650 
LNT04660 
LNT04670 
LNT04680 
LNT04690 
LNT04700 
LNT047IO 
LNT04720 
LNT04730 
LNT04740 
LNT04750 
LNT04760 
LNT04770 
LNT 04780 
LNT04790 
LNT04BO0 
LNT04810 
LNT04820 
LNT04830 
LNT04840 
LNT04850 
LNT04860 
LNT04870 
LNT04880 
LNT04890 
LNT04900 
LNT04910 
LNT0492C 


//  7X,  'MIN'  » lOX.  'MAX'  * lOX* 


PEROUT  . , . . 

♦ 'CON  = 2S5/!MAx-mIN)  ' //  ) 
PRINT  OUT  nEw  MAX«mU4,C0N  ARRAYS 
00  690  M=1»LC0mB 

690  WRITE  !6.700)mIN!M) *MAX(M) *CON(M) 
700  F0RMAT!5X.3(Ftt,4*5X) ) 


GO  TO  850 

710  IF  (PEROUT. GT.O)  GO  TO  730 
00  720  I=l*LCOMB 

IF  ! HAOMINCI)  .EO.  0 ) NEwMlN(I) 
IF  ! BAUMAXm  .EO.  0 ) NEWMAX(I) 
720  CONTINUE 


LNT 04930 

TRANSFOWMEO  DATA  RANGE*  AFTER  APPLICATION  OFLNT04940 


X TMIN(I) 
X TMAXCn 


730  WRITE  (6,740)NF 

740  FORMAT!/////  19X*  '*  OUTPUT  FILE  '*  13*  IX*  '*•  ) 

WRITE  (6,750) 

750  FORMAT!/////  Sx,**** 


Transformed  values  not  rescaled  *•*'  // 

1-'  * 12*  2X, 


1-'  » 12*  2X. 


WRITE  (6.760)LCOmR, (TMIn(I) *Is1*LC0M8) 

760  FOwMAT!/  5X,  'TRANSFORMED  MlNlMUMS*  COMPONENTS 

• //  2!SX,  6F12.2/)  ) 

WRITE  (6.770'LCOmR, (TMAX (I) «I=l*LC0M8) 

770  FO'-MAT!//  5x.  'TwAMSFOKMtU  maXIMUMS*  COMPONENTS 

• //  2!  5X,  8F12.2  / ) ) 

write  !6,780)LCOMH, !SlAS!l) *Ix1,LCOMB) 

7A0  FORMAT!///  5X.  'TRANSFORMED  VALUE  BUo,  COMPONENTS  I - 

• •:»  //  2!  sx,  BFia.r  / ) ) 


LNTO<*9SO 
LNT04960 
LNT04970 
LNT04980 
LNTOA990 
LNTOSOOO 
LNT05010 
LNT05020 
LNT05030 
LNT0S04O 
LNT05050 
LNT05060 
LNT05070 
LNT05080 
LNT05090 
LNT05100 
LNT05110 
LNT05120 
LNT05130 
LNT05140 
LNT05150 
LNT05160 
) LNT05170 

LNT05180 
LNT05190 
LNT05200 
LNT05210 
LNT0S220 
LNT0S230 
LNT0S240 
LNT05250 
LNT05260 
LNT05270 
LNT0S280 
I4.2X*LNT0S290 
LNT0S300 
LNT05310 
LNT0S320 


ryrt-t  .s-t  rt  o n rt  r»r>  r>  -»  r»rj  r>  r>  r>r> 


FILE  LNTRANI 


LNT05330 
LNT05340 
LNTosSse 
LNT053b0 
JLNT0S370 
LNTO530O 
LNT05390 
LNT05400 
LNT05410 
LNT05420 

800  format <///  5X»  *N0,  OF  TRANSFORMED  VALUES  GREATER  THAN  255  ( SET  sLNToIaaO 

♦ 255  ) :•  //  (5X. •COMPONENT'*  IX.  I2»',,.»»I6t  2X*  'VALUES'  ) ) LNToIaIo 

LNT05470 
LNT05480 
LNT05490 
LNTOSSPO 
LNTOSSIO 


WRITE  (6«790) (I«HADMIN(I) *I«ltLCOMB} 

790  format (///  5X»*N0.  OF  TRANSFORMED  VALUES  LESS  THAN  0 ( SET  » 0 > 
* • //  (5Xt 'COMPONENT'*  IX*  12*  * 16*  2X*  'VALUES*  ) ) 

WRITE  (6*800) (I*UADMAX(1) *I>l*LCdMB) 


NPERl  = FLOAT (PEROUT)/2.0 

, WRITE  (6*810)NPEr1*LCQMB* (MlrjCUT(I) *l*l*LCOMB) 

810  FORMAT!///  3K.  'NO.  OF  LOwEh  TAIL  POINTS  REJECTED 

♦OR  OUTPUT  ) TO  SATISFY'*  Fft.l*2X*'  CUT-OFF*  COMPONENTS 


( SET  = 0 FLNT05520 
-•  *LNT0S530 


1 


WRITE  (6.820) NPEPl *LCOMb* (mAXCUT ( I ) ♦ 1=1 .LCOMft) 

820  FORMAT!///  3X.  'NO.  OF  UPPER  TAIL  POINTS  REJECTED 

•OR  OUTPUT  ) TO  SATISFY'*  F6.1*  2X*  •_  CUT-OFF*  COMPONENTS 


14.  ?Xi 


• //  16(  18  ) ) 


>JPCT  = 100  - PEROUT 
WRITE  (6.83n)MPCT.LCOMH* (NEWMIN! I) *I=1*LC0M8) 


LNT05540 
LNT05S50 
LNT05560 
( SET  = 255  FLNT05S70 
1 -'LNT05580 

LNT05590 
LNT0S600 
LNT05610 


830  FORMAT!////  3X,»e***  FINAL  OUTPUt  TRANSFORMED  VALUES*  CENTRAL'  * LNt65620 
I5*3X.'_'_»  ?X*  'OF  distribution  :•  //  3X*  'MINIMUMS*  COMPOnENTSLNT05630 


» 


1 


14, 


// 


2!5X*  8F12.2  / ) 

14* 


WRITE  (6*840)LCOmB. (NEWMAX ( I ) * 1 = 1 *LC0M9) 
840  FORMAT!//  3X* 'MAXIMUMS*  COMPONENTS  1 - • 

* 2!  5X*  8F12.2  / ) ) 


PRINT  histograms 
850  CONTINUE 


2X, 


// 


r 

r 

r 

r 

c 

r 

c 

c 

c 

c 

c 


LNT0S640 
LNT05650 
LNT05660 
LNT05670 
LNT05680 
LNT05690 
LNT05700 
LNT0S710 
LNT05720 
LNT05730 
LNT05740 
LNT05750 
LNT05760 
LNT05770 
LNT05780 
LNT05790 
LNT05800 
LNTO501O 
LNT0S820 
LNT05830 
LNT 05840 
LNT05850 
LNT05860 
LNT0S870 

860  FORMATdril  //  5X* 'SCALING  PARAMETERS  USED  ON  TRANSFORMED  VALUES*  OLNT05890 
•UTPUT  FILE',  16//  19X.  'MINIMUM'*  7X*  'MAXIMUM'*  7X*  LNI05900 


XSIZ=101 

XHGM=255 

XLOr=0 

YSI7=15 

call  COMHST (F1LH1S,HISBUF*TTL*LC0M9*FETVC2*XSIZ*XHGH*XL0w*YSIZ) 
IF  (RESCAL.FO.O)  go  to  60 


WRITE  !6*860)NF 


♦ 'SCALE  FACTOR  ( CON  )•  ) 

WRITE  (6.870)  (F£TVC2(IL) *MIN( ID .MAX ( ID  *CON(lL) * IL  = l*LCOMB) 
870  FORmATUX*  'COMPONENT' * 13*  1A*F12.3*2X,F12. 3.7X.E12. 3 ) ' 

IF  (NPUN.LE.O)  go  to  890 

PUNCH  880, !CON(MN) *MIN(MN) *MN=1*LC0MB) 

880  FORMAT!  ! 'OPTION* ,4X*  'SCaFaC='  * 2!  • (•*  F9.3,  •*•  * E9.3* 
• ) . • ) ) ) 


890 


) * 

CONTINUE 


LNT05910 

LNT05920 

LNT0S930 

LNT0S940 

LNTU59S0 

LNT0S960 

LNT05970 

LNT0S980 

LNT0S990 

LNT06000 

LNT06010 

LN70o020 

LNT06030 

LNT06040 

LNT060SO 

LNT06060 

LNT06070 

LNT06080 


]^3^2 


FILE  LNTRAN 


C 

C 


IF  ( SCAFlG  .EO.  I » RETURN 


900 

910 


(LAM.EO.O)  GO  TO  920 
[TE  (6t910»FLDNA9 


60  TO  60 
IF 
WR I 

FO^'^AT  OATATk/LNTRAN 

•FlNlTlOfJ  CAWO»  FOR  FIELD  NAME  A<*,  1H'»  3X» 

• lOXf  ‘CONTINUING  TO  NEXT  FIELD  DEFINITION  CARD(S)* 
GO  TO  60 
920  CONTINUE 
RETURN 
END 


ERROR  ON  INPUT  FIELD 

•••••••  / 

////  ) 


LNT06090 
LNTOGIOO 
LNT06  10 
LNT06  |6 
LNT06  30 
LNT06  40 
LNT06150 
OELNT06  60 
LNT06  70 
LNTOo  80 
LNT06  90 
LNTOGlOO 
LNT062IO 
LNT06220 


ORIGINAL  PAbi.  .. 
OF  POOR  QUALITY 


nnnnnnnnn  nr>  oooo 


FILP:  MAXM*T 


SUR'^OUTINE  MAXMAT  ( MAXt  MINf  CON,  8MAT,  (.COMB,  MAXPT  ) 

COMPUTE  AN  approximate  TRANSFORMED  MAX  AND  MIN  FOR  EACH  COMPONENT 
OF  THE  transformation 

IMPLICIT  INTFOFR{A-Z) 

DIMENSION  MAXPTOO) 

REAL  BMAT(480),  MAX(16),  MINU6),  C0N(16) 


USING  INPUT  ( OW  default  ) MAXIMUM  DATA  VALUE  FOR  EACH 
channel.  COMPUTE  THE  TRANSFORMED  VALUE  RANGE  ( MAX  AND 
AND  COMPUTF  THE  HISTOGRAM  SCALING  FACTOR,  CON  , 


MIN  ) 


include  C0MSI\9,L1ST 
DATA  transformation  COMMON  hLOCK 

common/ TRHLCK/OUTFmT, NOFEAT, FLO  INF (6) , 


CSEND 


FETVECOO) 


C 

C 

C 

C 


10 


no  30  I=l.LCOMB 
MAX(T)  = 0.0 
M I N (I ) = 0.0 

no  ?0  J=l, nofeat 

K=(J-1)*LC0mr»i 

IF  (BmaTO^)  .LF.0.0)  GO  TO  10 

MAX(I)  = MAX(I)  ♦ 8MAT(K)  * MAXPT(J) 

GO  TO  70 
CONTINUE 

MIN(I)  = MIN(I)  ♦ BMAT(K)  * MAXPT(J) 


70  rONTlNUF 

rON(I)=(MAX(I)' 
in  CONTINUE 
RETURN 
END 


•MIN(I)  )/100. 


MXMOOOlO 

MXMOOOPO 

MXMOOOlO 

MXM00040 

MXM00050 

MXMOOOGO 

MXM00070 

MXM00080 

MXM00090 

MXMOOlOO 

MXMOOllO 

MXM00120 

MXM00130 

MXM00140 

MXMOOISO 

MXM00160 

MXMOOWO 

MXM00180 


MXM00200 

MXM00210 

MXM00220 

MXM00230 

MXHO0240 

MXM00250 

MXM00260 

MXM00270 

MXM00280 

MXM00290 

MXN00300 

MXMO031O 

MXM00320 

MXM00330 

MXM00340 

MXMO035O 

MXH003HO 

MXM00370 

MXM00380 

MXM00390 


riLFl  SETPEM 


SUPROUTINE  SETPEM 

• (CONKIN*  COMt  MlNf  AOONUM  * LC0M8  ) 

IMPLICIT  INTEPEP  U-7) 

PEAL  CON(liS)  . HINU6)  « C0NMIN(2»  16  ) 

NUMCM  s AOnNIJM  / 2 
IF  (NUmcm.NF.LCOmB)  60  TO  20 
no  In  NMal.LCOMR 
CON(NM)  s CONMINdt  NM) 

MTN(NM»  = C0NMIN(2»NH» 

10  CONTINUE 
PPTUHN 

?0  WPITF  (6.30)NUMCM»LCOMR 

30  FORMAT  (SX,  'SETREM  ERROR  - THERE  WERE  *t  15.  • SCALE  *. 

•factors  ano  minimum  values  input  Through  the  scafac  *. 

• OPTIOf  . * « 

/.  5*.  IS.  • LINEAR  combinations  WERE  PEQUESTEO, • . 

/.  SX,  *THE«E  MUST  RE  A SCALE  FACTOR  ANO  A MINIMUM 
•VALUE  FOR  EACH  LINEAR  COMrilNATlON, • , 

/,  SX,  tTHE  PROGRAM  WILL  TERMINATE  THROUGH  CMERR'I 
CALL  CMERR 
END 


SPEOOOlO 

SRE0002Q 

SRE00030 

SRE00040 

SPE00050 

SRE00060 

SRE00070 

SREOOORO 

SRE00090 

SREOOlOO 

SREOOnO 

SRE00120 

SRE00130 

SRE00I40 

SRE00150 

SRf.00160 

SREOniTO 

SPEOOlftO 

SRF00I90 

SRE00200 

SPE002I0 

SRE00220 
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FILE!  SETUPS 


C 

C 


SUBROUTINE  SETUPS (BMAT«(.C0MB,8MTRI6*PER0UTf MAXPT. ARRAY tLAM«SCAFLGi 

• TOP»  TRANSFt  RESCALt  BIAS.  AODNUM.  CONMIN.NPUN.NF) 

IMPLICIT  INTEGER(A-Z) 

LOGICAL  NUOTAP  « NUOFIL  . NU«;TAP  « NUSFIL 
REAL  C0NMINO2)  * BIAS(16)  , BMAT(480) 

DIMENSION  MAXPTOO) 
dimension  ARRAY(l) 

DIMENSION  E0UVEC(2) 

DIMENSION  CINOEXdO), 

• eflsTnP*’  PRVECK3)  , FWvEC2(3),  CARD2(62). 

DIMENSION  COVHDinS)  . OP(?)  . CP(2» 

DIMtNSION  MTX  (5) . ACARO (20» 

INCLUDE  COMflKl.LIST 
INCLUDE  COMRKA.LIST 
INCLUDE  C0MAK6.LIST 
INCLUDE  COMBKq.LIST 

C0MM0N/INF0HM/N0CLS2.N0SUB2.N0FET2.VARSZ2.T0TVT2.N0FLD2. 


* 

DATA 


kEND 


AVAR2.C0VAR2.CLSI02.SUBN02.SUB0S2.FL0SV2.VERTX2. 
FETVC2(30) .SUBVC?(Tb) .SUBPTR(7S) .CLSVC2(60) » 
REPPTS(60) .NOGRP,GRPNAM(60) »GRP0EX(6l) . 

6RPCHK (61) .GROUPS (124) 

DIMENSION  HEDl (15) .hED2(15) .DAtE(3) .COMENT (15) 

EQUIVALENCE  (HEOl ( 1 ) tHEAD (4) ) , (DATE ( 1 ). HEAD ( 22) ) . 

(HED2(1)  .hEaOOO)  ) . (COMENT(l)  .HE  AD  (46)  < 
COMMON/GLOBAL/HEAD(63) . MART AP.oAT APE .SAVTAP.BMF ILE.BMKEY. 

HISFIL.HISKEY.TRFnRM.ERlPTP.ERPKEY.MAPUNT.NOFILE. 

ORUMAO.DRMkDS.PAGSIZ.OATFIl.STAFIL.ASAV.ASAVFL 

»NHSTUN,NHSTFI.SCTRUN.MAPFIL 

.D0TUNT,D0TFIL.NCHPAS.TRNSFL,BHTRFL.HISTFL.PCHUNT. 
CROUNT.RRTUNT.RANUIO 
TRANSFORMATION  COMMON  BLOCK 

C0MM0N/TRHLCK/0UTFMT.N0FEaT.FL0INF(6)  , FETVECOO) 


equivalence  (FLOlNFd  ) ,LINSTR)  , (FLDINF(2)  .LINEnD)  . 

* (FLO  INF (3) .LINING) , (FLUINF(4) .SAMSTR) . 

* (FLDINF(5) .SAMEND) , (FL0INF(6) .SAMINC) 

data  CINDEX/'R-MA* ♦ »CHAN»  » 'FORM' . 'HtOl' . 'HE02*. 

* 'DATE' . 'COMM' , 'MAXR' . 'RERO' . 'sUBC  » 

♦•MOOU* , 'LAM  ' ♦ »OPTI ' . '*END' , 'Data* . 'STAT'. 

* 'RESC. 'BIAS'. 'TROU'/ 

DATA  MTX  / 4.  'O'.  'T'.  'S'.  »R'  / 

DATA  OR/  !♦'('/  . CP/  1 . ')'  / . ZERO/  0 / 

DATA  EQUVEC/1 . '='/ 

DATA  SlNVEC/2. '.'.'=•/. 

* CINMAX  /1R/.  MAXFET  /30/. 

* FRVECl/2. ' I • . 'O'/  .FRVEC2/2. 'U'. *L'/. BLANK/'  ./. 

* BTEST/2.'C'.'F'/ 

4 .CBCO/'C'/.FBCO/'F'/.UBCD/'U'/ 

DATA  COVHDl/'...  ' . 'ORIG' . ' INAL • . ' STa ' . ' T 1ST ' . ' ICS  '/ 

INITIALIZE  FLAGS  AND  DEFAULT  VALUES 

NOSUR2=0 
NOGRP=0 
RMTRIG=0 
NSF  = I 
RF.SCAL  = 0 
SCAFLG  = 0 
MPT  = 0 
ORIG  = 0 
TRANSF  = 0 
NRUN  3 0 
OUTFMTs^ 

TRFORM314 

initialize  The  transformation  bias  vector  ( BIAS  ) AND  NO.  OF 
BIAS  VALUES  ( N8S  ) 

DO  10  1=1.16 
10  BlASd)  3 0.0 


setosoio 

5CT0S02S 
SbT00030 
SET00040 
SETOOOSO 
SET00060 
SET00070 
SETOOOSO 
SETOOOVO 
SETOOlOO 
SETOOllO 
SET00120 
SET00130 
SET00140 
SET00150 
SET00160 
SET00170 
SETOOISO 
SET00190 
SET00200 
SET00210 
SET00220 
SET00230 
SET00240 
SET00250 
SET00260 
SET00270 
SET00280 
SET00290 
SET00300 
SET00310 
SET00320 
SET00330 
SET00340 
StT003S0 
SET00360 
SET00370 
SET003S0 
SET003VO 
SET00400 
SET00410 
SET00420 
SETO0430 
SET00440 
SET004SO 
SET00460 
SET00470 
SET00480 
SET00490 
SET00500 
SET00510 
SET00520 
SET00530 
SET00540 
SET00550 
Sf  T00S60 
SET00S70 
SET00580 
SET00590 
SET00600 
SET00610 
SE  T00620 
SET00630 
SET00640 
51100650 
SET00660 
SE  100670 
SET00680 
SET00690 
SET00700 
SET00710 
SET00720 
SET00730 
SET00740 
SETO0750 
SET007b0 
SET00770 
bET00780 
SET00790 


i3-16 


non  o onno  non 


Oliir.INAL 

pooll  QUALm 


SETUPS 

NBS  > 0 

NUOTAP  B 

.FALSE. 

NUOFIL  ■ 

.false. 

NUSTAP  * 

.FALSE. 

NUSFIL  » 

BMSWTbI 

.false. 

c 

c 

c 

c 


INITIALIZE  THE  MAXIMUM  EXPECTED  DaTA  VALUE*  FOR  EACH  CHANNEL 

00  20  Isl,30 
20  MAXPTU)«255 

INITIALIZE  _ DISTRIBUTION  CUT-OfF.  PEROUT  . AND 
THE  STANDARD  DEVIATION  MULTIPLE  * LAM  . 

LAM=2 
PER0UT=5 
DO  30  IsBtlS 
30  COVHOUn  B BLANK 

DO  40  I=1»1S  . 

40  COMENT(I)  b BLANK 

NOW  SET  UP  REREAD  BUFFER, 

CALL  REREAO(30*aO) 
so  COL=0 

NOW  READ  A CARO  INTO  THE  BUFFER 
REA0(21«S5) <ACARO(I) tlsltZO) 

55  FORMAT (20A4) 

WRITE (30*55) (ACARO(I) *1=1*20) 

REWIND  30 

STATFILE  CARD  READ 

IF  (NUSTAP  .OR.  NUSFIL)  SCAFLG  = 2 
HEAD  (30*60)COOE*CARD2 
bO  F0RMAT(A4*6Xtb2Al) 

REWIND  30 

WRITE  (6*70)CODE.CAR02 
TO  F0RMAT(T5*A4.6X.62A1) 

IF  ?ClN5EX(iK£O.C0DE)6O  TO  ( 11 0 * 150 . 160 * 180*  190  * 21 0*200*230 *250* 
♦270* 300*280*290 *500 *380 *430 *480 *490 *600) * I 
80  CONTINUE 

90  WRITE  (6*100)CODE*CAR02 

100  FORMAT!////  5X*»***  BAD  CONTROL  CARD  - 0ATATR/SETUP8  *•*•  //  5X* 
* A4*  OX*  62A1  ///  ) 

GO  TO  50 
8-MATRIX  CARO 
110  J=NXTCHR(CARD2.COL) 

IF  (J.EO. BLANK)  GO  TO  540 
COL=COL-l 

M=F1ND12(CARD2.C0L*8TEST) 

IF  (M.EO.-l)  GO  TO  540 
HMTRIG=1 

IF  (m.EQ.2)  60  TO  120 
B-MATRIX  DATA  ON  TAPE  FILE 
KEY=2 

READ  B-MATRIX  ARRAY  FROM  TAPE  FILE  , ^ 

CALL  BMFIL(BMAT*LCOMB*NOFEAT*EeTVEC*KEY) 

(iO  TO  130 

B-MATRIX  data  head  FROM  CARD  FILE 
120  KEY=1 

CALL  BMFIL (8MAT,LC0MB.N0FEAT*FfTVEC*KEY) 

130  N0FET2=N0FEAT 
N0FET4=LC0MB 
DO  140  B=1*N0FEAT 
140  FETVC2(B)*FETVEC(8) 

GO  TO  so 
FEATURE  CARD 
ISO  CONTINUE 
GO  TO  50 
format  CARO 
160  CONTINUE 

170  M=FIN012(CAHD2.COL*FRVEC1) 

IF  (M.EQ.-l)  GO  TO  540 
KZ=F1n012(CARD2.C0L*5INVEC) 


SETOOeOO 
SETOOaiO 
SET00820 
SCT00830 
SETO0B4O 
SETOOeSO 
SET00860 
SET00870 
SET00H80 
SET00890 
SET0090Q 
SET00910 
SET00920 
SET  00930 
SET00940 
SET00950 
SET00960 
SET00970 
5ET00980 
SET00990 
SETOIOOO 
SETOlOlO 
SET01020 
SET01030 
SET01040 
SET01050 
SET01060 
SET01070 
SETOIOBO 
SET0I090 
SETOllOO 
SETOlllO 
SETOligO 
SET01130 
SET01140 
SET01160 
SET01160 
SET01170 
StTOllBO 
SET01190 
SET01200 
5ET01210 
SLT01220 
SET01230 
SET01240 
SET01250 
SET01260 
SET01270 
SET01280 
SET01290 
SET01300 
5ET01310 
SET01320 
SET01330 
5ET01340 
SET013S0 
5ET01360 
SET01370 
5ET01380 
SET01390 
SET01400 
SET01410 
SET01420 
SET01430 
SLT01440 
SET01450 
SLT01460 
SET01470 
StT01480 
SET01490 
SET01500 
SLT01510 
SET01520 
SET01530 
St r 01540 
SET01550 
StTOlSbO 
SET01570 
5ET01580 


J:S'j 
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M»FIN012(CARp2.C0LtFRVEC2) 
FnA*l<^*3l  •AND.  (KH.E0.2) ) QUTfMT«1 
F( (H.EU.3) .AND* (KM. EG, 3) ) 0UTfHT>2 
•FjN012(CAfl02tC0L»SlNV£C) 

E GO  TO  50 

So  TO  170 
HEOl  CARD 

160  READ  (30*220)HED1 
REWIND  30 
60  TO  50 
HED2  CARD 

190  READ  (30*220)HE02 
REWIND  30 
60  TO  50 
comment  CARO 
200  READ  (30.220) COMENT 
REWIND  30 
60  TO  50 
DATE  CARO 

210  MaNXTCHH(CAR02.COL) 

IF  (M.EQ.65LANK)  60  TO  50 
READ  (30«220)DATE 
220  FORMAT(10X.15A4) 
rewind  30 
60  TC  50 
MAXPT  CARO 

230  J=NXTCMR(CAR02.C0L) 

IF  (J.EQ.I3LANK)  60  TO  5A0 
C0L=C0L-l 

MPT  = NUMBER!  CARD2.  COL.  MAXPt. 


MPT  ) 


IF  (MPT.6T.30)  60  TO  90 


K. 


GO  TO  50 
PEROUT  CARD 

250  J=NXTCHR(CARD?.COL) 

IF  (J.EQ. BLANK)  60  TO  540 
COL=COL-l 

M =„NUMBER  ( CAR02.  COL.  ARRAY,  ZERO  ) 
PEROUT  = ARRAY (1) 

IF  (M.NE.l)  GO  TO  90 

60  TO  50 
:>U8CLASS  CARO 

£f0  N0SUB2sNUMBER (CAHD2.COL.SUaVC2,NOSUB2) 
CALL  ORDER (SUBVC2.N0SUB2) 

60  TO  50 
LAM  CARO 

2«0  J=NXTCHR(CAR02.C0L) 

IF  (J.EO. BLANK)  60  TO  540 
C0L=C0L-1 

M = NUMBER  ( CARD2.  COL.  ARRAY,  ZERO  ) 
LAM  = AWHAY(l) 

IF  (M.NE.l)  GO  TO  90 

GO  TO  50 


OPTION  CARO 

290  M=FIN012(CAB02.COL.MTX) 

M = IABS(  M ) 

IF  (M.EQ.0.0H.M.GT.5)  60  TO  540 


IF  M = 1,  END-OF-CAWD  HAS  BEEN  REACHED 
GO  TO  (SO. 300.310.320. 35U) .M 

IF  M s 2.  iiO»»  . OR  t'ORTG" 

300  0RI6  = 1 
C 


5ET01590 


)160 

)161 


?8 


SETO 

SET0,_.. 
SETOlb20 
SET01639 
SET0‘ 
SETO 


940 

650 


SET01660 

SET01670 

SET01680 

SET01690 

SET01700 

SET01710 

SET01720 

SET01730 

SET01740 

SET01750 

SET01760 

SET01770 

SET01780 

SET01790 

SET01800 

SETOIBIO 

SET01820 

SET01830 

SE  T01840 

SETOlbSO 

SET01H60 

SET01870 

SET018H0 

SET01890 

SET01900 

SET01910 

SET01920 

SET01930 

SET01940 

SET 01 950 

SET01960 

SET01970 

SET019SO 

SET01990 

SET02000 

5ET02010 

SET02020 

SEr02030 

SET02040 

SET02050 

SET02060 

SET02070 

SET02080 

SET02090 

SET02100 

SET021 10 

SET02120 

SE  T02130 

StTO?140 

SF.TU2150 

SET02160 

Sh  T0217U 

SET02180 

SLT02190 

SLT02200 

SETO2210 

bE  T 02220 

SET02230 

SET02240 

SET022S0 

SE 102260 

SET02270 

SE  TH22H0 

St  I 02290 

SE  T02300 

SET02110 

SE'TC2320 

SE  T02330 

SE  T023A0 

SET02350 

SE  I 02360 

SLT02370 
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M > FIN012C  CAP02*  COL*  SINVEC  ) 

IF  (M.EQ.2)  60  TO  290 
60  TO  SO 

IF  M a 3.  iiT**  OH  ••THaNSF*' 

310  THANSF  * 1 

Me  FIN012(  CAH02*  COL*  SINVEC  ) 

IF  (M.EQ.2)  60  TO  290 
60  TO  50 

IF  M a 4*  * s*  — Check  for  ••scafac*** 

320  J a NXTCHH  ( CARD2.  COL  ) 

IF  NEXT  character  IS  * ASSUME  ••SCAFAC* 

IF  (J  .NE.  C8CD)  GO  TO  540 
Z a FIND12(  CARD2*  COL.  SINVEC  ) 

IF  (Z.E0.3)  GO  TO  330 
60  TO  540 

SCALE  factor  OPTION  : READ  SCALING  PAIRS.  CON  ANO  MIN 

CONMlN 

330  SCAFLG  a 3 

340  Z = FINDI2(  CARD2.  COL*  OP  ) 

IF  (Z.NE.2)  GO  TO  SO 

NMN  = FLTNUM  ( CAPO?,  COL.  COnMIN(NSF)  . 2 ) 

IF  (NMN.NE.2)  GO  TO  540 

AOONUM  = NSF  ♦ 1 

IF  ( (NSF+NMN) .GT.31)  GO  TO  50 

NSF  a NSF  ♦ NMN 

7.  a FIN0I2(  CAR02.  COL.  CP  ) 

IF  (Z.EQ.2)  GO  TO  340 

GO  TO  540 

PUNCH  OPTION 
350  NPUN  a 1 

GO  TO  290 

MODULE  STAT  DECK 

360  MKaNXTCHR (CARD2.COL) 

IF  (MK.NE.BTEST (3) ) 60  TO  370 

SCAFLG  a 

GO  TO  50 

370  CALL  CPDSTA(ARRAY.TOP) 

SCAFLG  a 2 


INTO 


SET02380 

SET02390 


IPSiU 

SETO  ■ 

, SETO 


400 
0 

430 

440 


SET02450 
SET02460 
StT02470 
SET024S0 
SET02490 
SET02500 
SET02510 
StT02520 
SET02530 
StT02540 
SET02550 
SET02560 
SET02570 
SET02580 
SET02590 
SET02600 
SET026I0 
SET02620 
5ET02630 
SET02640 
SET02650 
SET02660 
SET02670 
SETOPbHO 
SET02690 
SET02700 
5ET027I0 
SET02720 
SET02730 
SET02740 
SET02750 
SET02760 
SET02770 
SET02780 
SET02790 
SET02800 
StT02«10 
SET02H20 
SET02830 
StT02ft40 
SET02ft50 
SET028h0 
SLT02870 
SET02ee0 
StT02890 
5ET02900 
SFT02910 
SET02920 
SFT02930 
SET02940 
SLT02950 
SET02960 
SET02970 
SET029H0 
SET02990 
SET030C0 
SET03010 
SET 03020 
SET03030 
SF.T03040 
SET03050 
SE  T03060 
St  103070 
St  T030P0 
SE  T03090 
SLT03100 
StT03110 
St  T03120 
SETC3130 
St T 03 140 
SET031S0 
SETOSlbO 


oon  n non  n on  on  n non  non  non  nn  non  non 


FILEJ  SETUPS 


60  TO  SO 

DATAFILE  POSITIONING  CARO 

380  IF  (NUDTAP.AND.NUOFIL)  60  TO  So 

M ■ NXTCHR  ( CAR02  « COL  ) 

IF  (H. Ed. BLANK)  60  TO  SO 

IF  <H  .Ed.  UHCD)  60  TO  4I0 
IF  (M  .CO.  FRCO)  60  TO  aIo 
390  WRITE  (6*900) 

♦ •••***  OATATR/SETUPS 


400  FORMAT (///// 
•FILE  CARO  


CONTINUING  TO  PROCESS  INPUT 


» ERROR  ON  INPUT 
*#•*##  /////  ) 


60  TO  50 

410  J=FIN012(CAR02*C0L.E0UVEC) 

IF  (J.FQ.-n  GO  TO  390 
M»NUMBFR<CAR02*COL.OATAPC*TERO) 

C0L=C0L-l 

IF  (M.NE.l)  60  TO  390 
NUDTAP  = .TRUE. 

GO  TO  3«0 

420  J»F1N012(CAR02.C0L.EQUVEC) 

IF  (J.EO.-l)  GO  TO  390 

FILNO  a NUMBER  ( CAR02.  COL.  OaTFIL.  ZERO  ) 

IF  (FILNO. NE.l)  GO  TO  390 

NUOFIL  = .TRUE. 

DATFIL=DATFIL-1 
COL*COL-1 
GO  TO  3B0 

STATFILE  POSITIONING  CARD 

430  MsNXTCHH(CAPD2.COL) 

IF  (M.EQ. BLANK)  GO  TO  50 

IF  (M  .Ed.  UPCO)  GO  TO  460 
IF  (M  .Ed.  FBCD)  GO  TO  470 
440  WRITE  (6*450) 

450  FORMAT ( /////  5X* •***•*  0ATATR/SETUP8  •**•• 


ERROR  ON  INPUT  OR 


•PUT  CARO  — CONTINUING  TO  PROCESS  INPUT  *•*•••  ///  ) 

NUSTAP  = .FALSE. 

NUSFIL  = .FALSE. 

GO  TO  50 

460  J=FIN012(CARD2.C0L.E0UVEC) 

IF  (J.FO.-l)  GO  TO  440 
M=NUMRER(CAHD2*C0L*SAVTAP*ZER0) 

COL=COL-1 


IF  (M.NE.l)  60  TO  440 
‘NUSTAP  = .TRUE. 


GO  TO  430 

470  J»FIND12(CARD2*C0L*E0UVEC) 

IF  (J.EO.-l)  GO  TO  440 

FILST  a NUMBER!  CAWD2*  COL*  STaFIL*  ZERO  ) 


IF  (FILST. NE.l)  GO  TO  440 

‘NUSFIL  = .TRUE. 

STAFIL=STAFIL-1 
COL=COL-I 
GO  TO  430 


SE703170 
SET03l80 
SET03l90 
SET03200 
StT0321O 
SET03220 
SET03230 
SF.  TO  3240 
StT03250 
SCT0326Q 
SET03270 
SET032BU 
SET03290 
SET03300 
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SET03330 
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SET03670 
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SET03700 
SET03710 
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SET03740 
SET03750 
StT03760 
SET03770 
SET03780 
SET03790 
St  T03R00 
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SET  03820 
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j RESCALE  OPTION  CARO 
480  CONTINUE 

CODE  ADDED  JAN.  18*1979  TO  OOTPuT  MULTI-FILE  OUTPUT 

600  M ■ NXTCHR(CAR02«C0U 

!F  (M.EQ. BLANK)  GO  TO  50 
IF  (M.EQ.UHCP)  GO  TO  660 

If  «M.eo,FecO)  go  to  6To 

660  J ° FIN012<CAR02*C0L*EQUvCC) 

IF  (J.EQ.-l)  GO  TO  440 
M > NUM8ER(CAR02«COL*TRFoRM,ZERO) 


COL  » COL  -1 
IF  (M.NE.n  GO  TO  440 
GO  TO  600 

J » FIN012<CAR02.COL»E0UvEC) 
IF  (J.EQ,-1)  GO  TO  440 
M 3 NUMHER(CAR02tCOLtNF*7ERO) 
COL  « COL  - I 
GO  TO  50 

BIAS  CONTROL  CARO 
CONTINUE 

NH  3 NXTChR(CAR02.  COL) 

IF  (N8. EG. BLANK)  GO  TO  540 
COL  * COL  -1 
VECMAX  3 16  - N8S 


NK  3 NBS  ♦ 1 
NBS  3 FLTNUM 
60  TO  50 


(CAR02*  COL*  BIAS(NK)*  VECMAX) 


C *EN0*  CARD 
500  CONTINUE 


IF  ( RESCAL  .6T.  0 


SCAfLG  .EO.  0 ) SCAFL6  3 l 


IF  RESCALING  BY  THE  STATISTtCAI.  METHOD.  READ  STATISTICS  FROM 
FILE  ( SAVTAP  ) , REDUCE  THE  STATISTICS  TO  THE  SET  OF  CHANNELS 
SPECIFIED  IN  FETVC2  . AND  STORE  IN  ARRAY  . 

IF  ( SCAFLG  .EO.  2 ) CALL  REOsAVI  ARRAY*  TOP*  BMSWT  ) 

IF  (ORIG.EQ.O)  GO  TO  530 

DO  510  I3l,15 
TFMP  3 COMENT(I) 

COmENT<I)  3 COVHOl (I) 

510  COVHDl Cl)  = TEMP 

CALL  PRTCOV (ARRAY (C0VAR2) . AHRAv (AVAR2) .VAH5Z2.NOFET2. ARRAY (SUBDS2) 

*) 

DO  520  1=1.15 
520  COMENTCl)  = CCVHOl(I) 


C PRINT  OUT  THE  INPUT  TRANSFORMATION  MATRIX 

C 

C 

530  CALL  WRT8M(RMaT.N0FET4.N0FET2.FETVC2) 

C SET  NOCLS2=NOSUH2  FOR  REST  OF  PROGRAM 
N0CLS23N0SUB2 


IF  ( RESCAL 
RETURN 


SCAFLG  3 0 


SET03960 
56103970 
SETOSOSO 
SET 03990 
SET04000 
SET04010 
5LT04020 
SET0403C 
SET04040 
SET04050 
SET04060 
SET04070 
SET040A0 
SET04090 
SET04100 
SET04n0 
SETU4I20 
SET04130 
5ET04140 
SET04J50 
SETOaINO 
SET04170 
Sn04lB0 
StT04i90 
StT04200 
5tT04210 
SET04220 
SET04230 
SLT04240 
St  T04250 
SLT04260 
SET04270 
SET04280 
SET04290 
SET04300 
SET04310 
SET04320 
SET04330 
SLT04340 
SET04350 
SET04360 
SLT04370 
SET04380 
SET04390 
SET04400 
SLT04410 
SET04420 
SET04430 
5ET04440 
SET04450 
SET04460 
SET04A70 
SET044B0 
St  T04490 
SET04500 
SET04510 
SLT04520 
(SET04530 
SET04540 
St.T04S50 
St  T04560 
SET04S70 
StT04S80 
SFT04S90 
StTO4fcO0 
St  T04610 
Sb  r04620 
StT0<»630 
SbTO'tbAO 
St  T0A650 
SbT04t>60 
Stl 04670 
SbT046H0 
StT0<*69U 
StT04700 
stciJ4no 
St  T 0<«720 
SET  04  MO 
St.T04740 


FlLCt  SETUPa 


S40  WRITE  (6«SSOICOOEtCAR02 


550  FORMAT!////  SX*»< 


SET04750 

5tT0A760 

INVAUIO  control  CaRO  REJECTED  BY  OATATR/SETSf Tua770 


•UP8 


**  //  5Xf  AA«6Xt  62A1  ////  ) 


00  TO  SO 
END 


T0A700 
T0*7‘>0 
rOArtOO 
_TOAOIO 
.fcTOAOPO 
SETO«>By 
SETOAOAO 


oo-» 


FILPJ  TR4NSF 


CSENO 


► top#  IL«  K*  LCOMB*  NSAMP*  SIASI 

.cir'Sll.«'!“5-i?75io.  . BUS, 16. 

INCLUDE  COMPKPs  LIST 
A TPANSF5«**AT10N  common  block 

CONMON/TPBLCk/OUTFMT»NOFCAT»FLOINF«6I • FETVECC30I 


DIMENSION  lOATA  (TOP) 


SUPPOUTINE  ThaNSF  oof.s  a oata-transfobmation  using  the 

FORMULA 

XT  « IDATA  • PMAT  * BTAK 
*T  « COmPOnKNIC IL» t rPANSFORMEQ  DATA  VECTOR 
IDATA  B TUHUT  OaTa  vector  ( NOFEAT  X 1 ) 

RMAT  « TPaNSEOwmaTION  matrix  ( LCOMB  X NOFEAT  ) 
BIAS  « ADDITIVE  «1AS 


K 

IL 


no  lA  tt«i»noffat 

JSAMM  = (IT  - 1)  • NSAMP 
2CDMM  * LCOMB  • (IT  - I) 

XT  (IL)  «!  XT  (ID  ♦ . „ 

C inATA(JSAMp)  • RMaT(2COMB) 

10  XT  (ID  ♦ BIAS  (ID 

hfturn 
fnd 


TRAOOOIO 

TRAOOOPO 

TRAOOOTO 

TRAOOOAO 

TRAOOOSO 

TRA00060 


TRAOOOHO 

TRA00090 

TRAOQIOO 

TRAOOllO 

TRAOOltO 

TMA00130 

TRAOOIAO 

TRAOOiSO 

TRA00i*.0 

TRA00170 

TRAOOIBO 

TRAOOlPO 

TRAQQ?00 

TRAOOJlO 

TRAOOPPO 

TPA00230 

TR400^AO 

THAOO^SO 

TRA002AO 

TRA00270 


original  page  It 
OF  POUR  QUALrry 


ooono  or>ooor»  o *»  oaro:^ 


riLfl  TRHIST 


SUBROUTjNf  f<»Ml5T(IO*TA*AHA*»RNlN«ACQN»RH*T,L CO»»B* 
•PC**OUjjF!LHm»TOP*L*R«FLONRM*NC.V£RTCStM*«»MlN*CON( 


MlSTOTfRAM  THt  TR»NSrORMEO  Q*TA  ANO  CALCULATE, THE  MlN  MAX  AND  RANGE 
FOR  THIS  DATA  TO  ALLOA  RFSCALlNu  IN  ThE  0-255  RANGE 

IMPLICIT  TNTEGE«MA-Z) 

REAL  RlAS(lA)*  XT(I6>«  PERCEN(IA)*  MlN(lN),  HAX(16)f  C0N(16) 
REAL  BMATIAAO)*  AHIN(IA)*  AMAX(I6>«  AC0N(16) 
real  Xm|n  » XPER  * SUMEIL  • DUMMY 


P 

nCLI'OE 
NCl.iiOF 
Common/ 


C0M-<1 ,L 
C0M*iA4«L 
C04MK4.L 
CnM-(f«>.L 


INPO4M/NOCLS2.NOSUH?«NOfET2tVAPSZ2*TOTYT?.N0FLQ2»,  . , 
AVAS/.COVA<»2*fL*^Ii)P»SUBN5?*Si/HDS^iFLO$v2«VEPTX2, 
FFTVC?(30)  .S‘i^VC2(  TS)  .SUHMTR  ' AS)  «ClSVC2C60)  < 


^ropT<(^n)  .H0fi-<P»GPPNAMI60)  »UPP0EXI61>  ♦ 


QIMENSinN 

EOUlVALENrE 


Hcni (IS) .H  /o^(Is)  .lUTt' (3)  .COMENTUS) 
JhEDI  n ) .MFa'Mm)  ) . (OATf  ( 1 ) .hEAu(22) 


(WOUPSC  l/»4) 


) « 


DAT 

send 


<H£02(1 ) th€Al>l3n)  ) « (COMtNTU)  »HEA0i48)  ) 
COMMON/GLOdAL^«EAI)(S3) * IAPTAP.OAT APE .SAVTAPtbMFlLEtSMKEYt,.  ^ 
HlsnHHlSKrY*lMFO"’M,ERlPTM»EMP«tr«MAPUNT*NOriLE» 
0Oi|MAn.l)W'»*l)S»PAGSIZ*0ATFIL«STAFlL.AS4V»ASAVfL 
.NHSTIJN.WMSTFT.SCTPL'NfHAPFIL  , M . 

.DOT'I  JT  .nOTFlL  .-•JCMMAS  .TNNSFL  .HMTRFL  »HISTE  L t PCNUNT « 

CPfKlNT  .dwTdmT  tPANOIO 

TMAnsFop^aTION  common  hlock  , 

COMP0N/TPOLC*f/0tJTFMT.N0FEAT.FL0lNF(6)  ♦ FETVEC(30) 


OIMFNSTON  FILHlS(LCnM(.,101)  , 
VEPTCS(2.in .FL<«) ‘FLOINPiG) 


lDATA(TOP)t  T0TPTSU6)  « 


PEAD  TMF  COOPOlNATf 
OaU  to  HF  TPANSFOWMf 


VERTICES  ) Of  the  field*  FOP  THE 


10 


If 


AP*LA0E  AOCFt  0NAM*VERTCS*FL01NF*NC» 

*■  (lap.Eo.O)  go  to  2in 
<LAR.LF,-1)  00  TO  lo 

POSITION  the  input  data  TAPE  AND  READ  IN  THE  HEADER  RECORD 


20 


CALL  TAPHOP(  DATAPE  . OATFIL  » 

00  20  Isl.LCOHB 
MAX(I)»AMAK  * 

[ I ) sAMTN 


X(1) 

N(i) 

N(!) 


INF(4n/FL0|NF(6)*l 

NF(2)-FLniNF(l) )/FLUlNF(3) 


30 


MlN< , . ... 

C0N(1)«AC0N... 

NSAMP*(E-Ln|Nr  (5)-FLD 

LINt5»(FL0lNF(2)-FLn 

dummy  * (I  INFS»NSAMP)/2000 
A|^P»SOPT  (DUMMY) 
lf<ALP.LE.l)  ALP»1 
FLUINP( J )*FLnrNF(I) 

FLn!NP(/)sPLf>lNF<2) 

FLD|nP(4)»FL0)NF(4) 

FLi)iNP(S)sFL0INF(5) 

FLn|NP(3)«ALP 

FLOINP(0)*ALP  , . 

LINE  S*{FLOlNP(?)-FLniNP( 1 ) )/FL0INP(3) *1 
NSAMM*(FLOINO«S)-FLf'lNP(A)  )/FLUiNP(6)  •! 
CALL  FlOImT (FLulNP.FFTWECtNoFEAT) 

Un  30  !«l.LCOMb 
TOTPTS(I)  ■ n 

no  .lo  1*1.101 

FILHIS(1.J)»0. 

00  130  1*). LINES 

CALI  L INFwr»(  lOATA.ENDTAP) 

IF  (EN()TAP.<jE,0)  go  to  140 


TPHOOOlO 

TPH00020 

TRH00030 

TRH00040 

TPHOOOSO 

TMH00060 

TPHOOOTQ 

TRH0( 
TRhOO 
TRhoO] 
TRHOO 
TPHOOl 
TPHCOiSO 
TPHOQI ' ‘ 
twhoo 

TRMOO! 
TRHOO 
TWHOOi 
TRHOOJ 
TRHOO; 
TRM00230 
TRHU0240 
TRH00250 
TPH00260 
TRH00270 
TRH00250 
TRH00290 
TRH00300 
TWH00310 
TRH00320 
TKHO0J30 
TRH00340 
TRH00350 
TRHOP360 
TRHU037P 
TRH00380 
TRH00390 
TRHO04O0 
TMM00410 
TRH00420 
TRH00430 
TRH00440 
TPH00450 
TRHO0460 
TRHO0470 
1RH004BO 
TRH00490 
TRHOOSOO 
TRHOOSiO 
T»HO0|20 
TRHOOSSO 
TRHO0S40 
TRH00550 
TMHOOS60 
TRMO0S70 
TRH00S80 
T^HOOS90 
TRM00600 
TWHDOfelO 
TPH00620 
TRHO0630 
TMMO0ti40 
TkH00650 
TMH00660 
TWHU0670 
TMM004HO 
TwMOObOO 
TPH00700 
TRM00710 
TRM00720 
TWHO0730 
TRH00740 
TPMOn7S0 
TMMOO760 
TMM00770 
TMHO07P0 
T4M00790 


onoomo  n n oonooooo  non 


FlLt!  TRHIST 


IF  (I.NE.l)  GO  TO  40 
1LIN»FLD1NP(1) 

60  TO  50 

40  IL1N»IL1N*FL01NP(3) 

50  continue 

C6LL  FDLINT(VF»TCS»NC*FL.1UN.NS«JJ) 

DO  no  K*i,K'SA4P  tJKiriiXAL  PAfiP  T-^ 

KPX(K-1  )*FL DINP(6)  ♦FL01NPI4)  i -UiL  L' 

DO  100  LK*I.JJ»2  POOH  OUAi.rv 

LKPl  = LK  ♦ I / 'i.i  > 

IF  (KP.LT.FL(LK) > GO  TO  110 
IF  (KP.GT.FL (LKPl) ) GO  TO  90 
00  SO  Jal.LCOMB 
XT(J)sO. 

CALL  TOAMSF  TO  00  A DATA  THANSFORMAT ION 
call  TRANSF 

C (XT.  «MAT.  IOATA.  TOP.  J.  K.  LCOMB.  NSAMP.  BIAS) 

HISTOGOftM  THE  TRANSFORMED  DATA  ( USING  TRANSFORMED  DATA  MAX 
AND  MIN  AMO  scale  factor.  CON  . COMPUTED  IN  SUHR.  MAXMAT 
TO  flRTAlN  THE  HISTOGRAM  "BIN  LEVEL"  FOR  EACH  TRANSFORMED 
DATA  POINT  ) 

IF  (XT(J) .LF.mIN(J) ) GO  TO  60 
IF  (XT (J) .GE.MA* ( J) ) GO  TO  70 
OPTs(XT(J)-MIN(J) )/CON(J)*l 

IF(  DPT  .IE.  0)  OPT  = 1 

IF  ( DPT  .GT.  101  ) DPT  = 101 

FILHIS(J.nPT)=FILHIS( J.DPT)*1 
GO  TO  «n 

60  FILHIS(J.1)=FILHIS(J.1)^I 
GO  TO  HO 

70  FILHIS(J.)Ol)  * FILHIS(J.IOI)  ♦ 1 
BO  TOTPTS(J)=TOTPTS( J) *1  - 

an  TO  no 

90  IF  (LKP1.GE.JJ)  GO  TO  120 

100  continue 

110  CONTINUE 
IPn  CONTINUE 
130  continue 
140  CONTINUE 

ELIMlN-iTF  PEPOUT/2  OF  POINTS  FROM  UPPER  AND  LOWER  TAILS  OF 

THE  TR'NSFORmEO  OaTa'OISTRI-JUTION OriTAiN  THE  REVISED  max 

AND  scaling  parameters  CON  AND  MIN  AFTER  APPLICATION  OF  PtROUT 

XPER=PFRO'IT/200. 

CalCUI  ate  min.maX.AnO  con  arrays 
no  isn  i=i.lcomr 
ISO  PERCEN(I)=xPER*TOTPTS(I) 

DO  200  !=1.LCOMB 
XM1M=MIN(1 ) 

SilMFIl  =0. 

DO  IBO  js 1.101 
SUMFIL=<^UmFIL*FILHIS(I.J) 

IF  (SUMFIL.LT.PERCEN(I) ) GOTO  160 
M1N(  I ) = { J-n»CON(  1)  *XMIN 
GO  TO  170 

160  continue 

170  SUMFIL=0. 

J=102 
175  J=J-1 

SUM)-  IL  = 9UmFIL*FILhIS(I.  J) 

IF  (SUMFIl  .LT.PERCEN(l) ) GO  TO  180 
JMl  = J - 1 

MAX (I)  = JMl  * CON(I)  ♦ XMIN 
GO  TO  190 

IHO  IF(J.GT.l)  GO  TO  175 
19U  continue 

CON(l)  = 255.  / (MAX(I)  - MlN(l)) 

200  continue 


TRH00820 

TRH00830 

TRH00840 

TRHO0B50 

TRH0086Q 

TRHO0870 

TRH00880 

TRH00890 

TRH00900 

TRH00910 

TRH00920 

TRH00930 

TRH0Q94Q 

TRHO0950 

1RH00960 

TRH00970 

TRHOO90O 

TRM00990 

TPHOjotO 

TPHOloSO 

TRH0104Q 

TWM01050 

TRHoioeo 

TPH01070 

TPHOioSO 

TRH01090 

TRHOllOO 


TPHOlllO 

TRH01120 

TRH01130 


TRH0ii40 
TRH01150 
TRHOllbO 
TRM01170 
TPH01180 
TRH01190 
TRH01200 
TRH01210 
TRH01220 
TRH01230 
TRH01240 
TRH01250 
TRH01260 
TWr(01270 
TPH01280 
TRH01290 
TRH01300 
TRH01310 
TRHO1320 
TRH01330 
TRH01340 
TRH0135C 
TPrt01360 
TRH01370 
TRH01380 
TRH01390 
T“'HUl400 
1RH01410 
TRM01420 
TPH01430 
TRH01440 
TPH01450 
TRH01460 
TRHII1470 
. TSU014H0 
TRhOIrRO 
TRHOISOO 
TOHOlSlO 
TP-H01S20 
TRH01S30 
TRH01540 
TRH01550 
TRM01560 
TPHU1570 
TRrtOlSHO 


oooooo 


file:  TftMiST 


RETURN  THE  SCALING  PARAMETERS.  CON  AND 
rescale  THE  TRANSFORMED  DATA  TO  THE  RANGE 


MIN  « REQUIRED  TO 
t 0 - 255  . 


210  RETURN 
End 


TRH0J590 

TRH01600 

TRH016I0 

TRHUj620 

TWH0i630 

TRHU1640 

TRH01650 

TRH01660 


1 


'26 


FILP! 


• ^ 


CSEND 


14 . TRSTAT  PROCESSOR 


subroutine  TRSTAT (ARHAYtTOP) 

IMPLICIT  lNTEbFR<A-Z) 
f'l'^ENSTON  APPAVnOP) 

TNCLUDF  p^'iJXltLlST 

COMMON/INFOPw/NbcLS?,NOSUn2»NOFEp.VARS7PtTOTVT?»NOFL02f 

AVAW?»COVAR?tCLSIO?»SURNOr»SUPOS2»FLOSV?« VEPTX?. 
FFTVC?(30),SUhVC?(75>,SUflPTP(75).CLSyC2(60». 

i'FPPTS(ftO)  tN06RP»6KPNAM  (60)  *6PPDE*(6l)  • 
r-PPCMK(M)  .fiPOUPS(124)  -u-,,  r uM.,cv 

COMMON/GLORAL/HE  Af)(63)  •'^APT  AP  .PAT  APE  jSAVT  AP»BMFILE*HMKEY» 

hisfil.hiskev.tpfohm.epiptp.eopkey.mapunt.nufilf* 
nPllMAO«PWM'^nStPAGSIZ*nATFIL»STAFIL*  ASAV*  ASAVFL 
.HHSTUN.NmSTFI ,SCTPUN,MAPFIL  _ 

.00TUNT.00TFIL«NCHPAS*TPNSFL»BMTRFL»HISTFL»PCHUNT  t 

cpdunt.pp-tunt»«anoio 


PEAL  AMAT ( 1 AOO) .B (30) 

CALL  SFTUP‘y(APRAY.TOP.AMAT*ROW, 
CALL  TRAPTX  (ARRAYtTOP»AMAT»RO.(» 
RETURN 
END 


1P*TRAN«B) 

1P»TRAN#0) 


TRSOOOlO 

TRS00020 

TRS00030 

TPS00040 

TRSOOOSO 

COMOOOlO 

CO^IOOORO 

COM00030 

CCP^OOOAO 

COMOOOSO 

COMOOOlO 

COM00020 

COM00030 

COM00U40 

COMOOOSO 

COPOOOhO 

TRS00070 

IPSOOOfiO 

TRSOOOVO 

TRSOOlOO 

TPSOOllO 

TPS00120 


J,  I'.V.r  I: 


FILPJ  AMFIL 


CfENO 


SUPROUTIKE  AMFTL(POWtCOLUMN»AMAT*VEC*B) 

IMPLICIT  rNTF6ER<A-Z) 

TNCUIDF  COHPK6 

CO*'MON/GLOB«L/HE<,p(61)  .MAPTAP.0ATAPF.SAVTAP.BMFILE»BMKEY» 

HISFIL»HISKEY.TRFORM.EHIPTP»ERPKEV.MaPUNT.NOFILF. 
nRllMAD*f>RMWOS.PA6SI2tnATFIL*STAFIL»ASAV.ASAVFL 
• NHSTl'N»NHSTFl,SCTRUN»MAPFlL 

.OOTUnT.OOTFIL.nCHPAS»TRNSFL»BMTRFL*H1STFL.PCHUNT. 

CROU»«T  tPRTUNT  f RANOIO 

peal  AMAT(I)  .BOO)* 

DfMEf'lSION  VEC(l) 

PE»D(21 .g)  BOW.COLUMN, ( VEC « I ). I»l .COLUMN) 
lKaROW*COLUMN 

RF.An(?!,3)  UMAT<I)  .Isl.lK) 

RFAD(2).3)  (B(I) «I«1*RO«0 
return 

EORMAT(«iX,I?,5X.I2.2X»30l2) 

F0PMAT(5X.5E15.8) 

ENO 


AMFOOOlO 

AMEODOfO 

AMF00030 

AMF00040 

AMF00050 

AMF00060 

AMF00070 

AMFOOOPO 

AMF00090 

AHFOOlOO 

AMFOOUO 

AMF00120 

AMF00130 

AMF00140 

AMF00150 

AmF001<S0 

AMFOOITO 

AMFOOIBO 

AMF00190 

AMF00200 


2 


5 


FILFt  AMFILF 


€• 

C» 

C» 

C* 


C 


csENn 


c 


SURROUTINE  AMFILE (ROWtNOCHANtCHNVECt AMATtPVEC} 

AHFRE  WILL  READ  INTO  CORE  THE  A-MATRIX  AND  S VECTOR  FROM  UNIT 
7 


implicit  INTERFR  (A-2) 

REAL  AMAT(l),BVECn> 

INCLUOF  C0MRK6 

COMMON/GLOBAL/HEAD (63) »MAPTAP»0ATAPE.SAVTAP.BMF1LE»RMKEY*_ 

MlSFIL'»HlSKEY.TRFORM*ERIPTPtERPAEY.MAPUNT*NOFlLF* 
nRlJMAn.nR,M*DS.PAGSIZ«nATFIL*STAFIL»ASAV.ASAVFL 

•nhrtun.nmstfi.sctwun.mapfil 

,D0TUNT,00TFlL«NCHPAS»TRNSFL.BMTRFLtHI5TFLtPCHUNT* 
CHOUNT*PRTUNT«HANOIO 


niMgMSION  CHNVEC(l) 

REaD<7)  HO^*NOChaN» (CMNVEC(I) ♦l»lfNOCHAN) 

TOTAL  = N'OCHAN**? 

PEAO(7)  ( AMaT(I)  *Isl, TOTAL)  « (BVECd)  tlsltNOCHAN) 

RETURN 

END 


AMFOnOlO 

AMFOOOFO 

AMF00030 

AMF00040 

AMFOnOSO 

AMF00060 

AMF00070 

AMFOOORO 

AMF00090 

AMFOOlOO 

AMFOOllO 

AMFOOiZO 

AMF00130 

AMF00140 

AMF00150 

AMF00160 

AMF00170 

AMF00180 

AMFOOIRO 

AMFOolOO 

AMF00210 

AMF00220 


oor>  non 


FILE*  SETUP9 


CURMOUTINC  *;ETUP9(APRAY*TOP*AMAT«ROM«IP«TWAN*B) 
IMPLICIT  INTFGER(A-Z) 
peal  AMATURQO) *B<1) 

OIRENSION  array (TOP). ACARO<20) 

DIMENSION  CHNVEC(30) 

DIMENSION  CAkDl62)iClNDEX(12)*SINVEC(3) «SLASH(2) 


INCLUOF  COMRKI.LIST 
INCLUDE  C0M«K*,L1ST 


INCLUDE  COMMKf..LlSJ 
COMMON/INFORM/NOCLS2.NOSUB2.NOFET2.VAPS72.TOTVT2.NOFLD2. 

* ' AVAR2.C0VARP.CLSI02.SUBN02.SUPDS2.FLDSV2.VERTX2. 

• FFTVC2(30) .SUaVC2(75) .SUHPTR(75) *CLSVC2(60) . 

• KEPPTS(^O) .N06HP.6RPNaM(60) »6RPDEX(6l) . 

* fiRPCHK(f.l)  ,r,R0UPS(12A) 
dimension  HEDl (IS) ,hED2(IS)»0ATE(3).C0MENT(15) 
equivalence  (HEOl (1) *HEaO(4) ) « (DATE(l) *HEAD(22)) * 


(HED2(1)  .HEAOOO)  ) * (COM£NT(  1 ) •HEAD(A8> ) 
COMMON/OLOBAL/HFAO(63) .MAPTAP.OATAPE.SAVTAP.HMFILE.BMKEY. 

hISFIL.HISKEY.TRFORM.EWIPTP.ERPKEY.MAPUNT.NOFILE. 


5AVFL 


CSENO 


DRUMAO.DRMwnS.PAGSIZ.OATFIL.STAFlL.ASAV.A! 
.NhSTUN.NHSTFI,SCT«UN.MAPF1L 

.DOTUnT.OOTFIL.NChPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

chount.prtunt.hanoio 

data  blank/'  '/.EOUAL/'-'/.F/'F'/. 

* 5INVFC/2.'. '.**•/  .SLASH/l.'/'/. 

* P/»P'/,0/*0»/.T/'T'/ 

data  CiNDEX/'HFOl • . 'HED2' « 'COMM* . 

*'0ATF'»  'SUBC'.'A-PA* .'OPTI*. 

* *MOOU' . 'STAT* ♦ 'CHAN' « »*END'. ‘SEND*/ 

data  FBCO/'F'/,IBCD/*1'/,OBCD/'0»/.UBCD/'U»/ 

CINmax=12 

NOGRPsf) 

NOEUP2=0 
NOFET?aO 
rmrwT*i 
ASAVaQ 
ASAVFL*0 

SETUP  REREAD  BUFFER 

13  COL=0 

READ  A CARO  INTO  THE  BUFFER 

RE®D(?).?nO) (ACAPD(I) .I»1.20) 

200  FOPmaT(20A4) 

WRITE (30.200) (ACARO(I) »1«1 .20) 

REWIND  30 

PFADdO.Ul  CODE.CARD 

14  F0R“AT(A4,6X.62A1) 

REWIND  30 

WRTTF(6.15)  CODE.CARD 

15  foom4T(T5.A4,6X,62A1) 

DO  1?  IsI.CTNMAX 
IF  (CINOEXd)  .FO'.  CODE)  GO  TO 

1?  CONTINUE 

WRTTF(x.,31)  CODE.CARD 
31  FORMflT(/lX.44.ftX,62Al/'***  BAD 
GO  TO  13 
C HFOl  CARO 

2 OFAn(30,24)  HEOI 
rewind  30 
GO  TO  13 

?4  FORMAT(10X.15A4) 

C HFD2  CARD 

3 OEAD(30,24)  HE02 
REWIND  30 
GO  TD  13 

O COMMENT  CARO 

4 OF4D(30.24)  COMENT 
REwTNn  30 
GO  TO  13 

C DATE  CARD 

5 REaD(30,?4)  date 
REWIND  30 
GO  TO  13 

C SUBCLASS  CARO 


(2.3»A»5.6»fi.9.11»20.40»60.P0).I 
SUPERVISOR  CONTROL  CARO  SETUP9***' 


SETOOOlO 
SET00020 
SET00030 
SET00040 
SETOOOSO 
SET00060 
SET00070 
SETOOOBO 
SFT00090 
SETOOlOO 
SETOOllO 
SET00120 
SET00130 
SETOOUO 
SETooiso 
SET00160 
SET00170 
SETOOIBO 
SET00i90 
SET00200 
SET00210 
SET00220 
SET00230 
SET00240 
SET00250 
SET00260 
SFT00270 
SET00280 
SET00290 
SET00300 
SET00310 
SET00320 
SET00330 
5ET00340 
SET00350 
SET00360 
SET00370 
SET003B0 
SET00390 
SET00400 
SET00410 
SET00420 
SET00430 
SFT00440 
SET00450 
SETOOAftO 
SET00470 
SET00480 
SET00490 
SETOOSOO 
SETOOSIO 
SET00S20 
SET00530 
SET00S40 
SET00550 
SET00560 
SET00570 
SET00580 
SET00590 
) SET00600 
SET00610 
SET00620 
SET00630 
SET00640 
SET00650 
SET00660 
SET00670 
SET00580 
SET00690 
SFT00700 
SET00710 
SET00720 
SET00730 
SET00740 
Sf  T00750 
SET00760 
SFT00770 
SET007BO 
SET00790 


is 


Fite:  SETUP9 


«.  NOSUB?«NUMBFP<CAHO»COL»SUHVC2*NOSUB2) 
CALL  ORDER (SU0VC2«NOSUB2). 

60  TO  n 


READ  IN  a-maTRIX 
A CONTINUE 
AMTXSW  « >1 


C OPT TONS 


CALL  ANFIL (POW«NOCHAN,AMATtCHNVECtB> 
60  TO  13 


9 JaNXTCHR (CARO, COL) 
IF(J.FO.O)  6PI^«1 


IF(J.EO.BLANKJ 
TF(J.FO.P)  1P*1 


TO  16 


IF(J.FO.T)  TRAN»1 
m»FTN()12(CaPD,C0L,S1NVEC) 
lF(M,Ne-.2)  GO  TO  13 
60  TO  9 
MOnULE  CAPO 
11  vl*MXTCNR(CAPO,COL) 
TF(J.FO.F)  GO  TO  13 
CALL  CRDSTA( ARRAY, TOP) 


r« 

C* 

c» 


60  TO  13 

STAT  FILE  CAPO 

?0  M a NXTCHR (CAPO, COL) 

21  IF  <H  .EO.  BLANK)  60  TO  13 
IF  (M  ,F0.  TBCO)  60  TO  25 

IF  (M  .EO.  OBCO)  GO  TO  30 

??  wrtTFCS,2?2) 

222  format (»  ERROR  ON  STAT  FILE  CAPO*) 

oo  TO  n 

25  J = FIND12(CARO»COL, SLASH) 

IF  (J  .FO.  -1)  GO  TO  22 
2!^  M a NXTCHH  (CARD, COL) 

TF  (M  .EO.  '(PCD)  GO  TO  26 

IF  (M  .EO.  FPCO)  GO  TO  28 

GO  TO  21 

26  J = F1ND12(CaP0,C0L,SINVEC> 

IF  (J  .NE.  D GO  TO  22 
M a NUMBER (CAPO, COL, SAVTAP, ZERO) 
COL  = COL  - 1 
GO  TO  23 

2B  J = FIND12(CAR0,C0L,5INVEC) 

IF  (J  ,NE.  3)  GO  TO  22 

M = NUMPEH(CAWD, COL, STAFIL, ZERO) 

STAEIL  * STAFIL  - 1 

COL  = COL  - 1 

GO  TO  ?3 

30  J = FIND12(CARD, COL, SLASH) 

TF  ( J .EO.  -n  GO  TO  22 
3?  M a NXTCHP (CARO, COL) 

IE  (M  .FO.  URCO)  GO  TO  34 
TE  (M  .EG.  FhCO)  go  to  36 
r-0  TO  21 

34  J a EIN012(CAU0.C0L.SINVEC) 

TE  (J  .UE.  3)  GO  TO  22 
M a NUMBEWCCARD. COL, ASAV, ZERO) 

COL  » COL  - 1 
GO  TO  32 

36  J s EIN012(CAHn,COL,SINVEC) 

IE  (J  .NE.  3)  GO  TO  22 
M a NUMBER (CARO, COL, ASAVEL, ZERO) 
A5AVEL  = ASAVEL  - 1 
COL  * COL  - 1 
GO  TO  32 


ORIGINAL  PAGE  IS 
OF  POOR  quality 


c* 

c* 

c* 


CHANNEL  CARO 


40 


M a NXTCHR(CAPO,COL) 

' TE  (M  .FO.  PLANK)  GO  TO  16 
COL  = COL  - 1 

NOFET?  = nU'-'PER(CAP0,C0L,EETVC2,N0FET2) 
call  OROER (Ff TVC2.N0FET2) 

GO  TO  13 
C *ENO*  CAt^n 

60  CALL  REOSAV ( ARRAY. TOP. BMSHT) 

VAUS7  2 = ^iOEf  T?*(nOEET2*1)/2 
IF  (AMTXSW  .FO.  -1)  GO  TO  65 


SETOOeOO 
5ET00810 
SET00B20 
51100830 
SET00840 
5ET00850 
SE  T00660 
SET00870 
SET00860 

SET00910 

SET00920 

SET00930 

SET00940 

SET00950 

SET00960 

SET00970 

SET00980 

SET00990 

SETOIOOO 

SETOlOlO 

SET01020 

SET01030 

SET01040 

SET01050 

SET01060 

SET01070 

SET01080 

SET01090 

SETOllOO 

SETOlilO 

SET01120 

SET01130 

IF8III8 

SET01160 
SET01170 
SET01180 
SET01190 
SET01200 
SET01210 
SET01220 
SET01230 
SET01240 
StT0l250 
SET01260 
SET01270 
SET01280 
SET01290 
StT01300 
SFT01310 
SET01320 
SET01330 
SET01340 
5ET01350 
SET01360 
SET01370 
SET01380 
SET01390 
SET01400 
SET01410 
SET01420 
SET01430 
SF.T0l44.0 
5ET01450 
SfcT01460 
SE  T01470 
SET014B0 
SET01490 
5ET01500 
SET01510 
SET01520 
SF  T01530 
SET01540 
SET01H50 
StTOlSGO 
Sfc  T01570 
SET01580 


>kT 


FILFI  SETUP9 


CALL  AMFILE (fiOW«NOCHAN*CHNVEC« AMATt B) 

69  CONTINUE 
WBTTE  A-MATNIX 

fF\hpI6!EoIn”cALL°PHTCOV(Aft^YycSv^^  t ARRAY  (AVAR?)  tVARSZZ. 

*ir  .NOFETP  .FO,  NOCHAN,  60  TO 
WRITF (A, 100, N0FET2. NOCHAN 

100  format (•  NO.  OF  channels  FROM  STAT  FILE  OOFS  NOT  EQUAL  THE*/ 

NO.  OF  CHANNELS  ON  A-MATRIX  FILE.*/*  CHANNELS  ON  STAT  FILE  * 
• I?/*  CHANNFUS  ON  A-HaTRIX  » **  12, 

CALL  CMEHR 
send*  CARD 
flO  RETURN 
lA  HPTTF(A.19,  CARO 

19  F0RMAT<*  invalid  control  CARO  REJECTED  **»SETUP9**«* , 

RO  TO  13 
END 


SET01590 

Kioups 


J0l6A( 
:T0|650 
■ ,660 
= -1670 
■TOUSO 
[T01690 
..'TOITOO 
SFT01710 
SET01720 
SET01730 

SETOpS? 

SET01760 


FILFS  TRAMTX 


«U»ROIIT|N^  TRA:?TX<AR«AY.TOP»AMATt«Ott»IP»THAN*B) 


B(30)»AMAT(ROWf*">FET2) *AMEAN( 1600) • 


csENn 


*1 


^ INTE6FRU-Z) 

REAC  e(ROO)* 

•noiISUCC  (ROO) 

INCLUDE  COM'HKI.LIST 
INCLUDE  COMRKAtLIST 
INCLUDE  C0MRK6,L1ST 

common/infown/n5cls?»nosur?.nofet2.varsz?»totvt?.nofld2» 

• AVAR2.COVAH?.CLSID2.SUPN02iSUBOS2»FLOSV2,VERTX2. 

• FFTVC2O0)  tSUHVC2(7«>>  ♦SURPTR<75)  »CLSVC2<60)  ♦ 

• , KFPPTS(60) tN06RP»6MPNAM(60) fGRPDEXTol) » 

• 6RPCHK(A1) »RROUPS( 124) 

DIMENSION  HEDl<15)fHE02<15)«0ATE(3»fC0MENT<15) 
equivalence  (MEDl < 1 ) *HE40(4» ) , (DATE  < 1 ) .MEAD (22) ) * 

2 (HFDPd)  «HEAD(30)  ) • (COMENT(l)  •HEAD(4B) ) 

C0MM0N/6L0B«L/HEA[i(63) .M4PTaP.DATAPE .SAVTAP.BMFILE.BMKEY. 

• HISFIL.MISnEY.TRFOPM.ERIPTP.EPPKEY.MAPUNT.NOFILE. 

• DRUMAD.OPM*OS.PA(iSIZ.DATFIL.STAFIL.ASAV.ASAVFL 

• .NMSTUN.IjHSTFI  .SCTPUN.MAPFIL 

• .DOTUNT.OOTFIL.NCMPAS.TPNSFL.BMTMFL.MISTFL.PCHUNT. 

crount.prtunt.manoio 

DIMENSION  ARPAY(TOP) .NSUB(60) 

PUNCM*PCHUNT 



^'SUB(I)BAP.R4Y(IPP) 

NOFLO*NOFLD? 

OEMIND  ASAV 


IF  (ASAVFL  .EO,  0)  GO  TO  100 

POSITION  STAT  FILE 

CALL  FSR5FL(ASAV, ASAVFL. ISTaT) 
IFdSTAT  .EO.  0)  GO  TO  100 
FILNO  e ASAVFL  ♦ 1 
WPTTE{F..110)FILNO 

110  format M FWPOP  IN  TRYING  TO  POSITION 
♦NNTNG  OF  FILE '. I 3) 

CALL  CMPRR 
mo  CONTINUE 


<’RIGINAL  page  is 

Oi^  POOR  QUAUIY 


TRANSFORMED  STAT  FILE  TO 


33 

34 


3«; 

3R 


34 

37 

39 


31 

3? 


WRITE(ASAV)  NOCLS2.NOSUB2.ROW.NOFLO.TOTVT2. 

► (FETVC2(I» .I=1.N0FET2) 

IFdP.NE.I)  00  TO  38 
WRITE (PUNCH. 33) 

format ( 'MODULE  TRAINING  FIELD' DECK') 

WRITE (PUNCH, 34)  N0CLS?.N0SUfi2.R0w.N0EL0.T0TVT2 
format ( 'NOCLS  '.14.'  NOSUP  ».I2.'  NOFEAT  '.I2.'  NOELO  *.I3. 
* I TOTVWT  '.14) 

WRITF(PUNCH,3S)  (FETVC2d)  .I«1.N0FET2) 

FORMAT  ( 'CMNVEC.  4X.  301 2) 

CONTINUE 

J«FLDSV? 

<=VERTX? 

no  ? 1=1. NOELO 

JJ=J*3 

KK=K.?«ABRAY( JJ)-1 

wpitf(asav)  ( array (N) .N=J«JJ) 
writf(asav)  ( array (N) .NsK.KK) 
iFdP.K'E.I  ) GO  TO  3R 
WRITE  (PUNCH,  3F.)  ( ARRAY  (N)  .NsJ.JJ) 

EOOMAT  (A4,4X.m.flX,I?,8X,l?) 

WRITE (PUNCH, 37)  ( ARRAY (N) .NsK.KK) 

format ( 'VERTICES  *,1415) 

CONTINUE 

J=JJ*1 

MsKK.l 

CONTINUE 

KK=SURN0?*N0CLS2-1 

LL»5UHnS2*NOSUO?-I 

WPTTE(ASAV)  (ARRAY(J) .J»1.N0CLS2) . (ARRAY(K) ,K»SUBN02.KK ) . 

* (ARRAY (L) .L=SUP0S2.LL) 

TF(IP.EO.O)  GO  TO  23 

WRITF (PUNCH. 31 ) (ARRAY (J) , J=1 .N0CLS2) 

FO'5MAT  ((  'CL  SUES  ' ,?X.  A4,M  (4X,  A4)  ) ) 

WRITF (HUNCH, 3?)  (ARRAY (N) . K sSUBN02 . KK ) 

format (( 'SURNO  ' ,?4 ( 1 X, I?) ) ) 


TRAflOOlO 
TRAOOOlO 
TPA00030 
TKA00040 
TRAOOOSO 
TRA00060 
TPA00070 
TRA00080 
TPA00090 
TRAOOinO 
traoo; 
traoo 

TRAOOl 
TRA00140 
TPAOOISO 
TRA00160 
TPA00170 
TPAOOmO 
TRAOOI'AO 
TRAno200 
TPA00210 
TRA00220 
TRA00230 
TRa50245 
TPA00250 
TPA00260 
TPA00270 
TRA00260 
TRA00290 
TRA00300 
TRA00310 
TPA00320 
TRA00330 
TRA00340 
TRA00350 
TRA003h0 
TPA00370 
TRA00380 
BEGITRA003R0 
TRA004QO 
TRA00410 
TRA004P0 
TRA00430 
TRA00440 
TRA00<»50 
TMA004b0 
TRA00470 
TRA004AO 
TPA00490 
TRA00500 
TRA00510 
7RA00520 
TRA00530 
TRA00540 
TRA0OS50 
TRAOObbO 
TRA00570 
TRA00580 
TRA00590 
TRA00600 
TRAOOblO 
TPA00620 
TRA00630 
TRA00640 
TRA00650 
TRA00660 
IRAflObTO 
TPAOObflO 
TRA00690 
THA00700 
TRA00710 
TR400720 
TRA00730 
TRA00740 
TRA007SO 
TRA00760 
TRAHOTTO 
IPA00780 
TRA00790 


FILFJ  TRAMTX 


(AFo4AY(L)  •LaSUBOSZtLU 
•*10(AA»3X))} 


TRANS  STATS  AND  OUTPUT  THEM 


WRITE (PUNCH. 40) 

40  ro»MAT( ( 'SUBOES 
CONTINUE 

c FOR  FACH  SUHCLASS  COMPUTE 
JbAVAR? 

K»C0VArt2 

L«1 

KKKbI 

no  20  I«1.N0SUB2  ■ _ . 

pR*Rnw* (»0W*1 ) /2 

p««;upvc2n)  , 

kcNT«KKK**»P-1 

C MULTIPLY  A-MATPIX  PY  KEAN  VECTOR  ^ 

CALL  K6TVFC (AMAT. APHAY ( J) .AMEAN(L) .H0K.N0FET2) 
C 400  0 VECTOR  To  GET  TMANSFOMMEO  MEANS 
KM«0 

LL»L*R0«I-1 
no  21  I21*L.LL 
• KMrKM*1 


aMFANd?!)  =AMEAN»I21 ) ♦8(KM) 
COMPUTE  TRANSEOPmEO 


21. 


A-UftTR  * 
multiply 

CALL 

MULTIPLY 

CALL 


COVAP  matrix 
* A-MaTM  TRANSPOS! 
* CnVAH  AND  STORi 


QP 

ON 

07 

?2 


?n 


cnvAM  . 

A-maTR  * CnVAH  AND  STORE  IN  C.  _ 
MTMLSP{AMAT.ARRAY(K) »CiROW*NOFET2) 

C BY  A TRANSPOSE  AND  STORE  IN  ARRAY 
MTMOaT (C» AMaT. CC. row, NOFET2.R0r.0D. array (KKK) ) 
WRITECASAV)  (^EPPTS(P)  ,(ARRAY(I1).II-KKK.KCNT). 

• (AKEAN(II)  .lUL.LL) 

IFdP.FO.a)  GO  TO  2? 
mrTTF (PUNCH. v5)  KEPPTS(P) 

format ( 'NOPTS  •.OX.IM) 

WRITE (PUNCH. R6)  (AMEAN(II) .IIbL.LL) 

F0RMAT( 'MEANS' .5E1S. 8)  ,,  - - 

WRITE ( PUNCH. RT)  (ARRAY (II) • I IsKKK.KCNT) 

FOPMAT( 'COVAR' .SE15.8) 

CONTINUE 

JaJ.POW 

L»LL*1 

KKKaKKK.RP 

KsK.VAPSZa 

rONTlNUE 

IFdPAM.NE.l)  RETURN 
rV/IrROW^  ) / 2 

CALL  PBTCUV(ARRAY(1).AMEAN(1).CVI.R0W.NSUB(1)) 

fnofile  asav 

REWIND  ASAV 
END 


TRAOOBOO 

traoobIo 

traooa|o 

TRA00830 
TRAO0A40 
TRAO0B50 
TRA00860 
TPA00870 
TRAOOBBC 
TRAOOewO 
TRA00900 
TRAOOVIO 
TPA00920 
TRA00930 
TPA00940 
TRA00950 
TRA00960 
TPA00970 
TRA00980 
TRA00990 
TRAOIOOO 
TRAOlOlO 
TRA0io20 
TPAOj 
TPAO 
TRAO 

traoL  , 

TRA0107f 

TRAOlOflO 

TRA01090 

TRAOnOO 

TRAOillO 

TRA01120 

TRAOipO 

TPA01I40 

TRAOnSO 

TRAOiiSO 

TPA01170 

TRAoneo 

TRAOilRO 

TRA01200 

TPA01210 

TRA01220 

TRA01230 

TPA01240 

TRA01250 

TRA01260 


1030 

1040 

lOSO 


• i , 


flue:  wmTamT 


r 

c 


rsK'ji) 


SMBWnuTlNF  *WT4MT  (A'«ATtkO.rf.C0Lt»'"v«PeTVC?*a) 
i'<PLirtt  tmtp've»(a-7) 

I'jciiinf  CAM'^KAttlsT 
iNCLunr  CrM  t*f*i.i.  1ST 

.H^u^'ns) .ciiiTFn) .cqkfnt(is) 
touivAi.FMrF  (Ht-.ni  ( n .HKan  (<*))«  (■’ATP.  ( 1 ) **i£  All  (?7» ) • 

Z (‘*t  (’<?(  I ) tHP  Ai>nn)  ) « (C'^^-wT  ( 1 » »nf  aI>(<*6)  ) 

COMMON/t>Ln>'AL/«f  A >(PiT)  «'*AHTAP.nAT  ApL»SAvTA''.n'iFlLEt»*M<CY* 

• HlSP  II..'ilSnrv.T-<Pg-~i.tH’l--TPtP-i*iRtY.MAPUNT»NOFlLf  » 

• nPi'MAn,nBM,r»s.PAr,si7«n4Tr  iLfSTAriL»AS4v,ASAVFL 

• «MMSTt!M,  JI-STF  I tSCT-^ONtMAPP*  IL 

• «^)0TIJ^JT.'I0TF  IL  *.jCHPAS.TPN‘.FL»HMT‘<FL»tiISTFL*PChUNT» 

• C®DUMT.P‘fTu'iT»HAgiJ10 

pc’ai  AMtT  (po«'.C'^L'|''N)»B(  1 ) 

^T■''PMST()^'  F»-.T\/C>'T1  > .Ch(2J 
OAT  A CH/trH(  *,•  ) •/ 

*PITP.  (i^tHCai,) 

»->JTP(<’.m  i-(T)  tl»l  »Pu*‘> 

11  fopi-ATl*  p-vrcTn^  • . // 1 0 A . 1 ?PJ  ( .-f/lO* . l?El  0a»6E10.<*) 
*'PiTc:(^.n  ‘•■0v*r0LU'’«N 

{<«{? 

^ IP’(I'’'.'‘'T,COUI-^N)  I*<«COtU^N 
»'01TP(<>.?)  (CM,isI.^,lM 
wditfop.T)  (FETvC?(I)  tUIB.IK) 

KPlTF  (<'.M 
Iin  10  Jal.WOw 

IP  -i»1TF(P.4)  J.  ( A*'AT  ( I.I  ) .1*H*Ik) 

IF  ^^.FO.COull'’«fJ)  PETUKN 


IR*IA»1 

I*<*IK* 


r,n  TP 


12 


1 FnWMAT (///S7K, • A-'aT3IX*// 

• ^0/,iM('i.  OF  r>V -iIrj«T10''iS 

* Snx«»*'T.  OA  CH.A  Jr.LS  -'»I3) 
? FAP»'AT  (/1?«»12(?A4,>X)  ) 

3 FnwMAT  ( iH*  , I'iX,  1 1 ( 1 . 121 
ft  Fft-'-ATC  r!)  iPlNATl(t')S») 

<»  FnPMAT(l«.I'?.‘*X,l'!n*»t‘*,3)  ) 

END 


1.1/ 


WQTOOOIO 
MAT00020 
►WT00030 
><pT000<i0 
WPTO0P50 
aWTUOObO 
PWT00070 
•ft^TOOOBQ 
WBT00P90 
^RTOOIOO 
aWTOO  jo 
ikPTOOlZO 
MHTOOnO 
rf»T001ftO 

:sf8S  18 

WHTOO  70 
WRT00190 
MRT00190 
WRT00200 
WPT00210 
i*RTo0220 
«>^T00l30 
■■(PTOOZftO 
»RT00250 
i^RTOOlftn 
mpTOO<70 
NftTU02B0 
WPT00290 
»»PT  U0300 
■/RTOOllO 
mWTu03|0 
APT00330 
WPT00340 
«PT0035Q 
WRT00360 
rtP100370 
olHlOOiHO 
kpTo0390 
wPTOOAflO 
wKTOOftlO 


(ilLltnSA^ 

OF  I’lHtU 


15 


NDHIST  PROCESSOR 


riLfJ  NI>MIST 


SU«ROUT|N«:  (*«*»«YtTOP) 

t*  *m«l5T  IS  ThP  nmvEK  QOUTINE  FOW  ThF  N-OIHFNSION*L  PR0CfS50» 

r*  TWO  A*>HAYS  AWE  USFO  - PLANK  COMMON  ARWAY  CALLED  aWay(TOPI 

AND  AN  AWWAY  CALLED  MIST (LIMIT) 

OATA  L!’^IT/l?n00/  CM 

C 

ntvFNKioN  Hl<;T(l^noo> 

0!“FNSTnN  A^WAY(l). 

READ  !N  control  cards 
CALL  SFTIOCLIMIT) 

NDMSTl  IS  TmF  OWGANIZFR 

CALL  NOhSTI (hIST«ANPAV(1) ,ARRAY(280I) * ARRAY (AOl)f 
• LIMIT. AhRAY(I) .TOW) 

r 

RETUP'J 

c 

FNM 


okiujn'al,  page  is 
Oi'  P(JUii  QUALITY 


«;unPoiirtNr  tnn^rs(T0P.NS«»-M,N0fEAT*f*€6iN*BFGiNi i 
I*»»LlCfT  lNTK.re  <*-2»  . 

tncluof 
— iinF 


Cmmu 

Cf''*T 


iO»«MON  /MU*‘/NCL'<CH.CL«V£CnO>  .»»AKVfCtM*PKry,  • 

Cl  4SS.*ii>H?‘LS.ritL5.M?»N5WfNOyKC*rL0lNr<6).5IZC»I0TMNS 

,COLa»l.COLOB?»miFLFNflO^»C^OB3»NOl)UMP 


.inATAl.TOTVtC 


CO»«»*ON  i^LuC'*  Nnl*t.IS  USED  ONLY  BY  ThE  N-f)lKFNS10N4L  MlST06»*M 

FBOCFSSOK 

nFFlNITlONS' 


M4YVFC 

CLASS 

SU«CLS 

FIFLO 

NOVFC 

FLOfNF 

SI»F 


STOBE 

ON  CLASS  BASES 
ON  SUBCLASS  BASES 
ON  FIELD  bases 

will  be  computed 


C«  TOTMNS 

C*  CNTP? 

c«  101 

c«  id? 

C*  COl.O»l 

c*  COION? 

C«  PUFLFN 

r*  io‘» 

C»  COIONI 

C»  N00u«P 

c»  TOATAl 

C»  TOTVFC 

CONTIN'JP 
C OPAYMA®  and 
CSFNO 
f 

PASf  AnnwFssESS 


- NO.  OF  COLOP  ChANNFLS 

- ANWAY  CONTAINING  COLON  CHANNELS 

- MAXfHijH  NO,  OF  VFCTOkS  APPAY  HIST  CAN 

- ■<F.Y  inoicating  fields  will  HF  GWOUPEO 

- KEY  Indicating  fields  will  pI  gnoupeo 

- KEY  INOICaTInG  fields  will  grouped 

- WFY  INDICATING  MAANS  FOP  INPUT  FIELDS 

- NO.  OF  UNIOUE  VECTOP  mISTOGOAmmCD 

- APPAY  CONTAINING  PFCTanGULAP  FIELD  COOPOINATES  AWOUNO  ThE 
Input  FIELDS 

- nufft?/a  - NO.  OF  cohputep  wopds  to  stope  a packed 

HlFtOGPAMMfO  VFCTOP 

- TOTftl  NO.  OF  elements  in  ANHAY  CONTAINING  MEANS 

- ppr.iNNiwo  owuM  ahopess  foh  storing  fpeouency 

- AOnPESS  FOW  stoning  m cooes  in  APPAY 

- hE«INN1nG  I)N(|m  aooness  fop  stoning  10  cooes 

- AODPFSS  FON  stoning  color  COOES  IN  ARRAY 
RESlNNlNr,  ONUM  anOPFSS  FON  STORING  COLON  COO^S 


- AMOUNT  OF  storage  available  FOR  STONING  lO/COLOR  COOES 


ACCUml'LaTIVE  10  CODE  ORUM  ADDRESS 
--  “ COLON  ^ - 


ACCUMULATIVE  Colon  fooe  drum  aooness 
NO  OF  TI^ES  lO/COlOR  CODES  w£RE  OUMPEO 
stoning  IHAGENy  oaTa  “ 
VFCTOkS  IN  THE  AREA 

hist  cohmon  block 


AORkESS  FON 

total  no.  of 


ON  DRUM 
IN  ARNAY 

histognammeo 


C 

C 


F<)H  ARNAY 


ini  » isoi 
IDATAJ  « TOP  - 
IF  (lOATAl  ,0T 
wRTTFCP.inoi 
100  FORMAT!/  • TOO  MUCH 
• LINE*/'  ANAi/OC  NO. 

CALL  CI'FN^ 

JIO  ro^TINlJ^ 

PFMf)  a loon 

IF  (NCIRCH  .NF.  n»  MiFlFN 

!F  (NCI.kCh  ,F(..  0)  huFLEn 

IF  (MEANS*  .Fo.  n HUFLEN 

COLONl  * IDl  * KiJFLEN 


(nsamp«noffat  ♦ 1) 
NA.0O)  Go  TO  no 


DATA  RFOUESTEO, 
OF  CHANNELS') 


REDUCE  NO.  OF  SAMPLES  PER  SCAN 


NEMO 

nEhO 

REMO 


/ ? 


DRUM  ADONESSES 
CNTN?  « Nff.lN 

ID?  • CNTk?  ♦ 
COLOR?  « 103  . 


maavEC 

MAXVFC 


orgimal 

PEG  IN  I 


OPIJ-  START  ADONFSSES 
* CULDN?  • MAKVCC 


ID3  » Ik? 

rOI  0P3  » COLON? 

PFTUN!.' 

FND 


100( 

m 

looL 

BP  18 

ouooUo 

ooooiso 

DOOOIGO 

0000170 

OOOOlPO 

0000190 

ODO0|00 

DOOollO 

5ooo??o 

0000|30 
0000240 
OO002S0 
OOOOENO 
0000270 
DDOOIN 
OOf 


00340 
OD003S0 

?mn 

■ 003N0 
00390 
00400 


p004lO 
00042U 
0000430 
DD0044Q 
D0004SO 
00004GO 
0000470 
DOO04S0 
00004QO 
DOOOSOO 
DDOOSIO 
DDI/0S20 
OUOOS30 
DD0OS40 
OOOOSSO 
ADDOOSNO 
ADD00S70 
DDOOSSO 
UO00S90 
[•D00600 
iHiOOMO 
PU0O^^O 
0000630 
f)000h4(i 

00006SO 

0000660 

01)00670 

U0006MO 

00006RO 

AOD('0700 

A0000710 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


rtncLS 


r« 

c* 

r« 


<U»«OUTlNr  rLt>CL5lFIELnS.ST|kMNTt*f»**f  I»*T.VF.|fKXi 

FLOCLS  OHOuOS  TmF  FIELDS  rxAOS  ON  A CLASS  RASES  FOR  PROCESSING 


T»*®LIC1T  INTF«F*»  (A-2> 
iNCUtoF  COi-^t'l.LIST 
11.L»ST 


j^NCLUnF . c?'*:  1 


,SiJHPTNns».CLSfC«<60Tt 


KFFAtsiisoi  •NnGHP«GHRNAM<60>  «6^»*DEX  (6l  > • 


If;’"- 


CSENO 


^OMmon/1NFi)>m/nOL  .S^>NOSUR?*NC 

• «VA4r*COVAM?*CLi 

• FFTVC?CJOI»«nMV< 

• (CFPAfsc 

COMMON  /NOH/NCLRCM.CLAveCOn)  tMi . 

• Cl  ASS»Sli»jCLS*FIfLOtMFANSM.NOVEC»FtOlNFfH»SIZC*TOTMNS 

• «CNTHl.CNTR2t iOlf l02tCOLORI*COLONai(^FLEN«I03tCOLORJ*NOOUMP 

• .lOATil.TOTVEC  ^ 


FLDOflOlO 

FL000020 

FLU00030 

FLOOOOaO 

ithssii 

FLoipxi 

FLpodr 

FLUOO] 

mi 

FLDOOi 
FLOOOizO 
FLUOOIAO 
FL000I90 
00 


T« 

AO 


I 

C 


f 


niMENSIOK  FIFLDSIAf  n*VEMTEXa> 

LOrtICAL  Si-ITCM 
OATA  S*<ITCh/,TPUE./ 

IF  (K'OFU)?  .f-0.  n»  IPT  - I • 

IF  (NOFLD?  .FO,  0>  60  TO  ?X  » 

IPT  > IPT  ♦ FIFLDS(AfN0FLn?»*2 
rONTINUF 

60  TO  (-iO«  100)  .STAMNT  ^ . ^w,. 

T « I AOEAf)(FIEL0Sll»N0FL02*l)  «VERTEX(IPT)  ffLd'tf  ID  ♦F1ELOS(A»NOFLOFLOOO 
• 7*1) ) «:.««« 


^^88S| 

flood; 

FLOOOi 

FLOOD? 

FLOOD? 


C 

C 

C 


r 

c 

c 


WAA  CLASS»Si!HCLASS. field.  Ofi  SEND*  ENCOUNTEBEO 


IF  I I 

.FO, 

C-0 

TO 

90 

IF  1 1 

,FD. 

60 

TO 

IF  I I 

,F'i. 

T) 

60 

TO 

130 

IF  ( I 

.Ed. 

0) 

60 

TO 

lAO 

CLASS  r 

AhlO 

00 

IF  lA'.TTCH) 

60 

TO 

ion 

STA-^NT 

s ? 

QFTU'^') 

? 

loo 

MF»0I30 

.no: 

ICI.SVC2 

ID 

7') 

tPT  « 1 
»lO'*l.'J?  * 
NOA'Lr'?  « 

■ 

AWITTM  B 

ftO  TO  «0 


1 

<1 

0 

.FM  SF, 


110 

9ft 


no 


SliPCLASF  CA^O 

FO«»*AT(10».A*) 

»'06Uh2  « NOAtiM?  * 1 
PF AO  I TO, n ID  SUPVC2 (N0SUA2) 
PEwjNn  -^0 
OO  TO  "0 

FIFLO  CAPO 


NOF|.n? 

ATAMM 

MFTUP'i 

AENO* 


* lOFI  0?  ♦ 1 


I 


1 


1*0  PFTDMiJ  ^ 
FNO 


FLt 

FL0002A0 
FL000290 
FL00030Q 
FL000310 
FL000320 
FLQ0Q330 
FL0003a0 
FL0003S0 
f LOO03(SO 
FL000370 
FL0003A0 
FLOO03PO 
FLpOOAOO 
FLOOOAIO 
FLOOOAPO 
FLOOOA30 
FLOOOAAO 
FLOOOASO 
FL000A60 
FLOOOA70 
FLOOOASO 
FLOOOA90 
FLDOObOO 
FLOCOSIO 
FL000S20 
FL000530 
FLDOOSaO 
FLOOOSSO 
FLOOOSSO 
FL000S70 
FLDOOSAO 
FLO00S90 
FLD00600 

f Loooeio 

FLnOOfc?0 
FL000O30 
FL0006A0 
f L0006SO 
t-  LOOOOOO 
FL000670 
FLOOOfcSO 


FRF:  FLOFLn 


c 

C* 

C* 

C« 

C 

C 


rsE^n 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

r 

c 


«;UPR0UT1NE  FLPFLO (FIELDS. ST AMNT.«t*»IPT.VE»TEX» 

FLDFLO  CONTooL  Thf  PP0CESSIN6  OF  FIELDS  CAPOS  ON  A PEP  FIELD 

TMPLiriT  INTEOEP  (A-Z) 

INCLUDE  COm:<M.LIST 
TNCLUDF  C*-:?<n.LI«T 

COMHON/INFOiJK/NOCLSP.NOSUBp.NOFETZ.VAPSZP.TOTVTZ.NOFLOZ. 

• AVAK2.C0VAM?,CLSI02«SU‘<NO?.SUeDS2.FL0SV?.VERTX?. 

• FFTV(i?(SO»  ,SUBVC2(7S>  .SUPPTB(7S)  .CLSVC2(60)  t 

• •*  KFPOTSIMI)  »NORWP,GHPNAM(60)  .6RP0EX(61>  » 

• PPPCHKihl) .fiPOUPS(12A» 

common  /NDIM/NCLHCH«CLPVEC(30) .MAXVEC.HAPKFY. 

• CLaSS.SIi«CLS.F1ELO.meanS-.NOVEC.FLOINF(6) .size.totmns 

• .CNTPl ,CNTR?. IDl . mz.COLOPl .C0L0R2.BUFLEN, ID3. COLORS. NODUMP 
.lOATAl.TuTVEC 

dimension  FIFLDS(A.I) .VERTEX(I) 

NOFLD?  s 1 

TPT  = 1 


FLDOOOlO 
FLO0P020 
FLD00030 
BASESFLDOOOAtJ 
FL000050 
FL000060 
FLD00070 
FLDOOOHO 
FLU00090 
FLDOOIOO 
FLDOOllO 


SO  I s 


LAPEAO(FIEl.DS(I.NOFLD2)  .VEPTEXdPT)  .FLOINF(l)  » 
FIELDS(4.N(jFLD2)  ) 


WAS  CLASS.SueCLASS. FIELD.  OH  $ENU»  ENCOUNTERED 


IF 

IF 

IF 

IF 


• FO. 

• F ‘.I  • 

.FO. 

.FQ. 


-1) 

-2) 

1) 

0) 


GO 

GO 

GO 

GO 


TO 

TO 

TO 

TO 


90 

no 

120 

130 


CLASS  CARD 


90 


inn 


no 


RFAO(3n.lOO)CLSVC2(l) 
RFwiNn  '■<0 
N0rLS2  = 1 
FORMAT  (1(;X,AA) 

RO  TO  so 

SUBCLASS  CAHO 

REA0n0.100)SUOVC2(l) 
REHIKO  30 
M09U«?=1 
GO  TO  SO 


FIELD  COHO 
l?n  HFTUR3  1 
SEND* 

130  RETURN  2 
FNO 


FLDP0120 

FLD00130 

FLOOOIAO 

FLDOOISO 

FL000160 

FL000170 

FLDOOISO 

FL000190 

FL000200 

FLD00210 

FLD00220 

FL000230 

FL000240 

FLO0O2S0 

FLD002GO 

FLD00270 

FLD002RO 

FL000290 

FLD00300 

FLD00310 

FL000320 

FLD00330 

FLD00340 

FLD003S0 

FL0003<SO 

FLD00370 

FLO003H0 

FL000390 

FLPO0400 

FLD00410 

FLD00420 

FLD00430 

FLD00440 

FL000450 

FLD00460 

FLD00470 

FLO004A0 

FLD00490 

FLD00500 

FLD00510 

FLOO0S20 

FL000530 

FLO00S40 

FLOOPbSO 

FLD00560 

FLU00S70 


r*nr*o  r»  r»r» 


FILF!  FLHMFN 


C* 

C 


‘iU'^f'OUTlNE  *'Ln‘'FNnDATA»J,NSAHP*N0FEAT.MF.ANSt86CHANtN>' 

FLHMEn  COMPtITFS  TmE  FIELO  PEANS 

TM®LICIT  INTFGEH  <A-7) 

PEAL  MFANS«P»«n 
TNCLUPF  COPa*-ULlPT 
TNCLDOF  CPMKlltLlST 

COMMON/ IN^  nt-M/NOCLS?.NOSUn?,NOFET2.VAPS.!?»TOTVT?.NOFLD2» 

• AVA«?»CnVA«?tCLSin2.SUPNO?.SllPOS?.FLOSV?»VEHTX?» 

• FETVC2C10)  tSliftVC?(7S)  .SUPPTR(75)  .CLSVC?(60)  . 

• ^KEPPTSd^n) ,NOGRP.6WPNAM560) ♦GPP0EK(6l»  t 

• fiPPCHK  (f»n»  GROUPS  (12A) 

COMMON  /NniM/NCLHCH.CLRVECOO)  ,MAXVFC«MAPKEY. 

• CLASS.SllPCLS.Fiei.0tMFANSWtN0VFC.PL0INF(6>  .SIZE.TOTMNS 

• ♦rNTRl.CNTR2,IDl.lD2*COLOPl.COLOR2fBUFLENflD3.COLOR3*NODUHP 

• f IOATAl»TOTVEC 


DIMENSION  1DATA(NSAMP,N0FFAT) »MEANS(NCLRCH.1) 
MEANS  = ( (N-l)*OLD  MEAN  ) /N  ♦ DATA  PT./N 


(! 


C 


RND  = (FLDaT(im)-1,0)/FLOAT(N) 

ICHAN  = 0 

DO  100  K = RGCHAN. NOFEAT 
TCMAN  = ICHAN  ♦ 1 

100  MEANS ( ICHAN. NOFL02)  = RND*MEANS ( ICHAN. NOFLD2)  ♦ 

* FLOATUDATA(J.Kn/FLOAT(N) 


return 

FNn 


FLDOOOIO 

FLD00020 

FL000030 

FLOOOOAO 

FLDOOOBO 

FL000060 

FL000070 

FLOOOOAO 

FL000090 

FLDOOlOO 

FLOOOnO 

FL000120 

FL000130 

FL000140 

FL000150 

FL000160 

FLD00170 

FLOOOIBO 

FL000190 

FL000200 

FLD00210 

FL000220 

FLD00230 

FLD00240 

FLD002S0 

FL0002GO 

FLD00270 

FLD00280 

FLD00290 

FL000300 

FL000310 

FLD00320 

FL000330 


FILFl  FLDSUR 


C 

C* 

C* 

r* 

c» 

c 

c 


RUPBOUTINE  FLOPUW(FlELaS.STAMNTt«t*.«.IPT. VERTEX)' 


FLnSUH 

LEVEL 


CONTROL  The  PROCESSING  OF  THE  FIELD  CAROS  ON  THE  SUBCLASS 


FLOOOOIO 

FLOOOOPO 

FLD00030 

FLUOOOAO 

FLDOOOSO 

FL000060 

FL000070 

FL000080 

FL000090 

COMOOOlO 

COMOOOPO 

COH00030 

COM00040 

COM00050 


CSENO 

c 

c 


LOGICAL  SWITCH 

DATA  SWITCH/, TRUE./ 

niMENSION  FTEL0S(4*1) ,VERTEX(1) 


IF 

IF 


(N0FL02 

(K'OFLO? 


,EO. 

,EU. 


0) 

0) 


IPT  = 
GO  TO 


1 

7S 


C 

C 


75 


IPT  = IPT 
CONTINUE 


♦ FIELDS(4,N0FLD2)»2 


60  TO  (S0»110»90) «STAMNT 


«n  I 


c 

c 

c 


c 

c 

c 


*2*1) ) 

WAS  CL4SS«5URCLASS, FIELD,  OR  SEND*  CARO  ENCOUNTERED 


IF  (I 
IF  (I 
IF  (I 
IF  (I 


,E0. 

.EO. 

.FO. 

.t-O. 


-1) 

-2) 

1) 

0) 


GO 

GO 

GO 

GO 


TO 

TO 

TO 

TO 


ftS 

100 

130 

140 


C 

c 

c 


5=; 


QO 


100 

110 

l?n 


c 

c 

c 


c 

c 

c 


130 


IMPLICIT  INTEGER  (A-Z) 

INCLUOF  COH-.t<l  ,LIST 
INCLUDE  CMnWii.LlST 

COMMON/ I NF0RR/N0CLS/»,N0SUR?*N0FET2»VAHS7?* TOT VT2,N0FLD2» 

* AVAO2,C0VAR?,CLSI02,SURN02,SUB0S2»Fl0SV2,VERTX2, 

* ' FF.TVC2(30)  ,SUBVC2<75)  ,SURPTR(75)  «CLSVC2(60>  ♦ 

* KEPPTS (40) ,N06RP,6RPNAM(60) ,GRPOEX (61) * 

* GRPf.HK(5l)  ,GR0UPS(124) 

COMMON  /NPIM/NrtRCH.CLRVEC (30) ,MAXVEC,MAPKFY, 

* CLASS, SDRCLS. field, MEANSW,N0VEC,FL0INF(6) ,SIZE»T0TMNS 

* ,CNTR1.CNTR2, 101,102, COLOR l,COLOH2,BUFLEN,ID3,COLOR3,NODUMP 

* ,I0ATA1,T0TVEC 

FLOOOllO 
FL000120 
FL000130 
FL000140 
FL000150 
FL000160 
FL000170 
FLCDOlflO 
FL000190 
FLD00200 
FLD00210 
FLD00220 
FL000230 

= LAREAO (FIELDS ( 1 ,N0FLD2*1 ) ♦ VERTEX ( IPT) ,FLOINE ( 1 ) ,F lELOS ( 4 ,NOFLDFLD00240 

FL000250 
FLOOOZftO 
FLD00270 
FLD002«0 
FL000290 
FLD00300 
FLD00310 
FLD00320 
FLD00330 
FLD00340 
FL000350 
FL000360 
FL000370 
FLD00380 
FL000390 
FLD00400 
FLD00410 
FL000420 
FL000430 
FLD00440 
FL000450 
FL000460 
FL000470 
FLDO04fl0 
FL000490 
FLOOOSOO 
FL000510 
FLOOOSao 
FLDOOS30 
FLD00540 
FL0005SO 
FLO00S40 
FLU00570 
FLDOOSflO 
FLD00590 
FL000600 
F LD0061 0 
FLDO0G20 
FLDO0630 
FL000640 
FL0006SO 
FtnOOGGO 
FLt)O0F70 
FLDO0b«0 
F LDOObRO 


CLASS  CARD 


TF(SWITCH)  GO  TO  90  ’ 
STAMNT  = 3 
SWITCH  = .TRUE. 

PE TOR M ? 

PEA0(30, 1?0)CLSVC2(1 ( 
PEW  I Nr  30 
N0CLS2  = 1 
GO  TO  flO 

SUBCLASS  CARD 

IF  (SWITCH)  GO  TO  110 
STAMNT  = ? 

RETURN  ? 

»EAD(30,120)SURVC2(1) 
PEWiNn  30 
FOPmaT(10K,A4) 

NOFLD?  = 0 
N0SIIR2  = 1 
IPT  = 1 

SWITCH  s .FALSE. 

GO  TO  00 

FIELD  CARD 


N0FL02 

STAMNT 

return 

SEND* 


= N0FLD2 
= 1 
1 


140  RETURN  3 
END 


111 


FII.FS  NONSTl 


C« 

r* 

c* 

c* 


«;U«»H0IJT1NE  NriHSTl  (HiST.FIFLOSt 


>»|rAN<;«VFPTEK,Ll»^ITtAW^#Y,TOP) 


I^OWSTI  SETS  »iP  The  logic  FOM  MIST06HAHM1N6  THE  OATA  AND  tehITING 
TMF  FitF 


IMPLICIT  INTEGER 

OfAL  MFANS 


A? 

AS 


(A-7) 


OlMfNSION  HlST(l>,APPAY(n»*«»EANS(l)  .. 

ni^ENSION  FIELr)S<A»l)  .FETVECOO)  tFL(12)  »Vf.RTEXm 


INCLUDE  COMtiKj.L  si 
TNCLUDF  COhi-Kft.L  ST 
INCLUDE  CfH" T1«LIST 


CSEND 

C 


Oft 

AO 


rOMMON/lNfOP*'/NOCLS?.NOSUA?»NOFET2.VAOSZ?.TOTVT?*NOFLn?, 

AVAP?.COV4H?.CLSlD2*SUSNO|.SUPI)S2»FLD5V?»VERTX?t 
FFTVC2(30» .SUBVC2(75) .SUBPTH(7S) .CLSVC2(60) . 
kFPPTS(SO)  «NOGRP«GHPNAM(GO)  fGPP0EX(6n« 

GHPCHAlbl) »GROUPS(124)  

C0MM0N/6L0fci*L/HEAD(63) ,M«PTAP,OATAPEjSAVTAPtPMFILE.HMKEY. 

HISFIL*HlSKEY»TBFnRM,ERIPTP»ERPKEY.HAPUNT*NOFILE» 
noi)MAn,nPM^OS.PAGSIZ.OATFIL»STAFIL»ASAV,ASAVFL 
,NHSTUN.wh?TF1,SCTPUN»MAPFIL 

,noTllNT»OOTPlL»NCMpAS,TBNSFLf0MTRFL«HISTFL»PCMUNT» 
rpmjMT.Ph'TUNT.HANUlO 

COMMON  /NOI'VNCLPCH.CLWVECOO)  .MAXVEC.MAPKEYj 

CLASStBi)HCLSfFIEL0tMEANSW*NOVEC»FLOlNF(6) .SIZE*T0TMNS 
.CNTPl ,rNTR2,ini»I02»COLOHltCOLOR2»PUFLEN»ID3»COLOH3»NOOUMP 

,10ATA1*T0TVEC 

initialize  parameters 

TENTER  = 0 
STA^'NT  = 1 
LENTH  = N0VFC*SIZE 
no  AD  JK=1. LENTH 
HTST(JK)  = n 
begin  = nPil''AD 

nvPFt  0 = 0 ... 

V/FCCNT  = 0 V t i 

NOnURP  = 0 
NOVPC  = 0 
TOTVFC  » A 
NOPLD?  = 0 
TOTVT?  = 0 

IF  (vFanS»  .nF,  1)  GO  TO  AS 

no  A?  1 = 1 .TOT’^NS 

•'F'NS(T)  = 0,0 

TF^TclaSS  ,P  ■>.  1 ) CALL  FLDCLS  (FIELDS*STAMNT,M0O,a51O,L52O,  TPT, 

*TF  (SilPCLs'^.FO,*! ) Call  FLOSUt)  (FIELDS, STAMNT, L100»L5in,AS20»  TPT» 
*TF  (FIElO  1)  CALL  FLOPLO  (F  IELDS»ST  AMNT  , M 00  ,iS30,  IPT  , VFPTFX ) 


page  is 
quality 


r 


c. 


c 

c 

r 


r 

r 

c 


100  LINSTR  = PL'^INF(l) 

LINFND  = FLr'INFC?) 

I IMTNC  = FloiInFO) 

SAMSTW  = FI.''INP(A) 
aamF.Ni)  = FLO»InF(S-) 

GA“INC  = FLf'lNF(f>) 
FiFLrs(2.U'jFi.n?)  = NOcLS? 
FIFLC*^!  3,  ■‘OFl.n^)  = NOSUf-i? 

TOTyT?  = F IFLOS (a.NOFLDZ) 
IF  (•'FANS*  .F'J.  1)  TOTMNS 


♦ T0TVT2 

= NCL«CH  ♦ TOTMNS 


ILTNF  s (LINFNn-LlNSTP) /lining  ♦ 1 
NSAMP  = (SA  >iFNO-SAMSTP) /SAMINC  ♦ 1 


COMPINf  Pl.orTI^G  AND  COLOR  CHANNELS 


no  1U<  T = l,'nPFT2 
lift  FFTVFrtn  = FFTvf.?(I) 

IF  (»^'CI  RCH  ,F0.  U)  GO  TO  130 

ABF  rni  OR  C-'ANNrL'^  AND  PLOTTING  CHANNELS  THF  SAME  CHANNELS 


101 


IF  (NOFFT?  .NK.  NCLRCH)  GO  TO  102 
no  101  1 = 1,  'OFF  1 2 ^ ^ 

TF  (FFTVFC(T)  ,NF  . CLRYFC(D)  GO  TO 
roGT  ’Ml*' 

NOFF  AT  = i‘OFF  r? 


102 


NOHOOOlO 

n(<hO0020 

n1)HO0U30 

NOHOOOAO 

ndhooosu 

AiIih00060 

MiHOOOTO 

MOHOOUHO 

MDHOOOPO 

NDHOOlOO 

NOHnono 

NUH00120 

NDHO0130 

NDHOOUO 

NDHOOiSO 

NOHOOlGO 

NDH00170 

NOH00180 

NOHOOIRO 

NUH00200 

NOH00210 

NDH00220 

NOH00230 

NOHO02AO 

NOH00250 

NDH002GO 

NDH00270 

NDH002RO 

NOHft0290 

NDH00300 

N0H00310 

NDH00320 

NDH0033U 

NDH00340 

NPH003SO 

NCHOOSftO 

N0H00370 

NOH003H0 

NDH00390 

NOMOOAOO 

NDHOOAIO 

NDhOOAZO 

NOHOOA30 

ndmooaao 

nDhOOASO 

nhhooapo 

N(ihO0*70 

NDH00A80 

nohouapo 

NOHOOSOO 

NUHO0510 

NDM00S20 

NOH00S30 

NDHOOSaO 

NDHOOSSO 

NOHO0S6O 

NDH00S70 

NOHOOSAO 

NOhOOSPO 

nohoonoo 

N0M00610 

NOM00620 

NOH00630 

NDHOObAO 

NPrtOObSO 

NPH006G0 

NDMOObTO 

NUMOOftMO 

NPHOOftPO 

MIHO0700 

NOHO071O 

NDH007?0 

NPH00730 

N|)H007a0 

NIjmOOTSO 

M;HO07AiO 

NliHno770 

fJ|,-io07H0 

N(/m007P0 


non  ooo  oo  o o o or>o  ooo  o ooo  ooo  oooo  ooono 


riLFl  WOMSTl 


nGCMA\'  s 1 
RO  TO  \ iS 
10?  rONTlfJiJF 

no  i?o  l«l.NCt>cw 
1?0  FFTVFC(^0FeT?♦^  » CLWVECd) 
no  NOFfOT  s fJOFFT?  ♦ NCL«CM 

O0CH»*g  » NuFFT?  ♦ 1 
n«t  roMTiNue 

r.OMPUTF  40D-»ESSES  . 

CALL  AnDRES(r0PtNSAHP«N0FEAT*bC61N*BEGINI ) 

TF  PFmAINInO  STOPAOF  IN  HIST  ARRAY  IS  LESS 
hist  array  (DATA  VECTORS)  ONTO  DRUHt  READ 
DRUM,  Then  read  data  VECTORS  BACK  INTO  HIS 

TF  (RAPKEY  ,NE.  1)  GO  TO  105 
STORPF  r limit  - N0VEC*SI7E 
IF  (STOOGE  ,1-T,  ?U00)  GO  TO  103 

CALL  STOOAT(ILINE.NSAMP.HIst(NOVEC*l>  tSTORGEtBEGINl ) 
GO  TO  105 

103  VFCTRI  s COLOR? 

WROS  = •'iOVEr*ST7E 

CALL  hwriTE(VECTh1.hIST»vP0S  .ISTaT) 

104  TF  (ISTaT  .FQ,  1)  GO  TO  104 
RE6IN1  = VECTRl  ♦ WROS 

CALL  STOOAK ILINE.NSAMP,hIST«LIMIT*BEGIN1) 

CALL  RREAD(vECTR1.MIST»WR0S»ISTAT2) 


INITII  I7E  IMAGE  DATA  TAPE 

lOS  CALL  TAPhnR(OATARF.DATFlL) 
lOG  IF  (ISTAT?  .EQ.  1)  GO  TO  106 

position  Image  tape  FOR  ThIS  FIELD 

CALL  FL0INT(FLDINF(1) «FETvEC»NOFEAT) 
nltne  s 0 
npts  = 0 

READ  A scan  line  OF  DATA  AND  PROCESS  IT 

00  SCO  line=ukstr.lineno.lininc 

NLTNF  = NLINF  ♦ 1 

CALL  LTf'‘EMO(ARRAY(IDATAl)  ,FN0TAP) 
if  (FNOTaP  .ECl.  -1)  GO  TO  600 

READ  IN  A SCAN  LINE  FrOm  CLASSIFICATION/CLUSTER  MAP  TAPE 

IF  (MaPkEY  ,E0.  1)  CALL  RFSTO (NL INE .NSAMP,BEGIN1 ) 

FIND  intersfcttons  fo»  n-p  fields 

CALL  FDLlNTCVEOTtK (IPT) tFIFLOS(4,NOFL02) *FL»LINEt  SAMP,NI) 

no  400  j= 1 tNi , ? 

IP  = (FL ( J) -SAMSTR) /SaMINC  ♦ 1 

TF  = (FL(J*n-  Sa^str) /Samjmc  ♦ 1 . , 

TF  (WOO (SJMSTR. SAVING)  ,NF.  MOO (Fl ( J) tSAMlNC) ) IB  = IB  ♦ I 
IF  (IP  ,GT.  IF)  GO  TO  400 

00  3S0  rsiH.IE 

TOTVFC  = TOTVFC  ♦ 1 
NPTS  = NFTS  ♦ 1 
HISTOGPIM  VFCTOB 

/ CALL  MI^>-isT?(K.APwAY(lnATAl  ) tHlSTtNOFET?»VECSwT»NSAMP» 

* APRAY(l)  • VF.CCNT»OVRFLO.NOFEAT*elGCHAN) 

IF  A NFW  VFCTOR  WAS  FOUND. VECSWT  » 1 

??0  IF  (MFfl,,(Sw  ,F0,  0)  GO  TO  330 

rOMPUTF  Mf  A'iS  FOR  training/test  FIELDS 


than 

^N  MAP 


2000*  EMPTY 
TAPE*STORE  ONTO 


nohoohoo 

NDH00910 
NDH00620 
NDH00830 
NDH00P40 
NOH00650 
NDM00660 
NOH00870 
NDH008PO 
NDH00850 
MDHOOROO 
NDHOOVIO 
MDH00920 
NDH00930 
NDH00940 
NDH00950 
NDH00960 
NDH00970 
NDH009B0 
NDH 00990 
NOMOIOOO 
NDHOlOlO 
NDH01020 
NDH01030 
NDH01040 
NDHOIOSO 
NDH01060 
NOH01070 
NOHOIOPO 
NDH01090 
NDHOllOO 
NDHOillO 
NDHOl 120 
NDhOI 130 
N'DMOl  1*0 
NDHOl ISO 
NDHOllOO 
NOM01170 
NDH01180 
NDHOllOO 
NOH01200 
NDH01210 
NOH01220 
NDM01230 
NDH01240 
NDH012S0 
MDM01260 
NOH01270 
NDH012P0 
NDH012O0 
NDH01300 
NDhOI 310 
NDH01320 
NDH01330 
NDH01340 
NDH013SO 
NDHOI 360 
NDHOI 370 
NDM013P0 
NDH01390 
NDhOI 400 
NDhoUIO 
NDH01420 
NOH01430 
NDH01440 
MH014S0 
NUHO 1 460 
f'OHOUTn 
NDhOI  4 P() 
NI‘H014R0 
NDHfllSOO 
NDHOlsio 
r-i'HUlSPO 
f-DHniS30 
NDhOI S40 
NDHOlbSO 
M'h()1S6(I 
DUHdlbTO 
NOnniSSO 


r>!*>r»  oor>r>  r>  n or»'>  o nrtrt 


fiLft  M0M5T1 


CALL  FLf)KEr4(AW.}AY<  inATAl)  »K.NSAt*f'»NOPEATtMFANS»«GCM*»<«NPTS» 

TF  (VECSWT  .WF.  1)  GO  TO  350 

ARBAV<TD1  ♦ VECCNT)  » NOFLOZ 
IF  IPAPKFr  ,EO.  0)  GO  TO  3A0 

OETRTEVE  CLUSTEWED/CLASSIFIEO  DATA  FROM  DRUM 

CALL  PFSTOH(K.ARPAr'(10l*VFCCNT) ) 

340  VECCNT  * VFCCNT  • 1 

IF  (VfCCM  ,LE.  <PUFLFN-l)»  60  TO  350 


nu**P  ONTO  DRUM 
NODUMP  s NOO(JMP  ♦ 1 

CALL  HWftlTEdDJ.APRAYdOl)  *BUFLEN.1STAT1) 

ID’  * li'?  ♦ HUFLEN 

vErcN'T  s n 

IF  (‘•EANSrf  ,PO.  1)  GO  TO  350 
IF  (NCI.RCH  ,FO.  0)  GO  TO  350 

CALL  RwritF  (rnLOP?.A«BAY(COLORl)  tPUFLENdSTAT?) 

COLOR?  » COLO*<?  ♦ HUFLEN 

?5n  CONTINUE 

400  CONTINUE 
500  continue 

IF  OVRFLO  15  greater  THAN  0*  HISTOGPAMMEO  DATA  VECTOR  TABLE  IS 
PULL 


C 


TF  (OVRFLU  .EO,  0)  GO  TO  505 
wOTTP (5.2?l) 

2?1  FOPf'fT  (////> 

whtte(6.?2h)OvpflO 

??P  format ( 1 X, 14, • VECTORS  WERE  NOT  HISTOGR AmmED»  BUT  USED 
•G  FIFLD  KEANS,  IF  applicable*)  ' 

505  CONTI NUF 

IF  (FIELD  ,NE.  1)  GO  TO  B5 

CALL  •*PTFIL(Ml5T,MF;ANS'AKPAYdDl ) .ARRAY  (COLOR  1 ) »FIELOS, VERTEX, 

• TENTF-J) 

GO  TO  RO 

WRITE  HlSTOPi  AV  FILE 

510  CALL  wRTFIL  (H  1ST , ME ANS» APR AY (101 ) , ARRAY (COLORl) »F lELOS* VERTF X, 

• IFNTE-^) 

GO  TO  RO 

5EN0  CAPO  found 

CAI.L  - RTF IL(hIST,mEANS» ARRAY (101) .ARRAY (COLORl) .FIELDS, VERTEX, 

• TFNIF,;) 

en^filE  nhstuf; 

REWIND  nhSTUN 

return 

■/RTTE  (4.610) 

format  (•  FRRf'R  IN  field  CARO.  ABORTING*) 

CALL  CMERH 
fnd 


NDM015R0 
N|)H0}600 
NDHOIGIO 
NOH0i6|0 
NDHOlbSO 
NOH0164U 
NDMOi650 
NDH01660 
NDH01670 
NOH016BO 
NDH016R0 
NDH01700 
NDM0|710 
NOM01720 
NOH01730 
NOH0i740 
NOMOI750 
NDH01760 
NDH0i770 
NOH017e0 
NUH0i790 
NOH01800 
NDHOlOlO 
NDH01B20 
NDM01P30 
NOH01840 
NDh01B50 
NDH01860 
NDH01870 
NDHOIPBO 
NDH01890 
NDH01900 
NDH01910 
NDH01920 
NOH01930 
N0H01940 
NDH01950 
IN  COMPUT1NNOH01960 
NDM01970 


5?n 

5-xn 


400 

410 


MDH019H0 
NDHOt 990 
NDH02000 
NDM02010 
NDH02020 
NUMO2O3O 
NOH02040 
N[)M02050 
NUH02040 
NDM02070 
NDH020R0 
N0H02090 
NDM02100 
NDMOPIIO 
NUH02120 
NIJM02i30 
NDH02140 
NDM021SO 
UOH02160 
NOH02170 
NOM021B0 
N('lH(J?l90 
N0H02200 
NDH02210 


■ ^ AGE  is 

QL'ALITY 


FTLF!  NOHST? 


C 

C* 

?: 


c 

c 

c 


subroutine  'yrHST?(J,10ATA»HlST.NOFET2»VECSWT.NSAMp, array* VECfNTt 
♦ 0VRFL0»N0FE*T»b6CHAN) 

NOMST?  PERFORMS  ThE  1 TO 
THF  HIsTOGmam  is  COMliuTtO  FO 


CHANNEL  HISTOGRAM 

R either  one  or  two 


sets  of  channels 


implicit  Integer 
OImFnsion  hIsT(S1 


CSENO 
C 


(A-Z» 

(SIZE*MAXVEC) «10ATA(l) tCOMWROIAl 
OIMENSTON  AHRAYd) 

INCLUOE  C0H*»K6.LI^T 

INCLUOF  CMRW'lltLlST 

COMMON/GLObAL/HEAO (6:T) .MAPTAP,nATAPE»SAVTAP,BMFILE.%MKEY* 

hisfil»hisk£y«trform,ehiptp,erpkey,mapunt#nofilf* 

0RlHAD*nRMv.DS.FA6SIZ»DATFIL»STAFILf  ASAV*ASAVFL 
.NHSTUNtNHSTF I.SCTRUN.MflPFIL 

.D0TUNT*D0TFIL*NCHPAS»TRNSFL*BMTRFL»HISTFL*PCHUNT* 

CPnONT.PRTUNTtRAMniO 

common  /NOIm/nCLHCh.CLRVEC (30) tMAXVECtMAPKEY* 

CLASS. SUHCLS.FIEL0tMF4NS«<tN0VEC»FL0INF  (6)  .SI2E.TOTMNS 
.CNTPl .CNTR2.I01.lO2.C0L0Rl.C0L0R2.aUFLEN.l03»C0L0R3»N0nUMP 

.lOATAl.TOTYEC 


VECSWT 


n 


sn 


LOGICAL*!  LOliMI*)  .LLOi)M(A) 

FO((IVALENCE(10UM,LDIIM(1)  ) , (IIOUM.LLOOMn)  ) 

no  so  1=1,4 
COMORO < I ) *0 
TI=0 

no  #>n  T = 1,N0FET2 
II=II*1 

III=l*(II-l)/4 
T1IIs.)*(I-1)*NSamp 
TRYTE  = n-((II-l)/4)*4 
IFUS'YTE.F'J.  1)  IlOL'MaO 
inijM=inAT4(iiii) 

LLnUM(T-iYl£)  *LnuM(4) 
roMwwn(iii)=iiouM 

40  CONTI  Ml  It 

BTOPE  LAST  « BITS  OF  IDATA(IIII)  INTO  COMWRO(III)  IN 
BYTE  POBITIO'.  I4YTE.  LEFT  TO  RIGHT 
IF  (MCLRCH  .Ffv.  0)  GO  TO  100 
IF  (MFANS-f  .FQ.  1)  60  TO  100 

CALL  PTCOLR( lOATA, J,NOFEaT.COLWRO,NSAMP,NOFET2.PGCMAN) 
100  r.ONTINUc 

IF  (NOVFC  .EO.  0)  GO  TO  13b 

C0MP6WI^'^.  VECTORS  4LWEA0Y  FOUND  tolTH  IN  COMING  VECTOR 


no  no  no  r*i,:vovec 


c 

c 

r 

r 

r 

r 

c 

c 

c 


C 

c 

r 


i?o 


no  1?0  Lai. SITE 
IF  (COM^wfML)  ,NE. 
CONTINUE 


HIST(L.K) ) 60  TO  130 


FOUND  A •'ATCHING  VECTOR 
no  OAP  OF  TWE  EOLI  O-JiNG  : 

1)  HISTdGWav  T»F  VICTOR  ONLY  IF  COLOR  CODES  FOR  BOTH  VECTORS  ARE 
THE  Cave. 

?.  no  MOT  C^ECK  COLOR  CODES  IF  MAP  TAPE  IS  BEING  INPUT  OR  MEANS 
FOR  FIELD‘S  A‘<E  RFING  COMPUTED 


IF 

IF 


(NCI.RCH 
(Mf  A NS  ■> 


.EO, 
• EL  I 


0) 

1) 


GO 

60 


TO 

TO 


126 

126 


IS  COLOR  CODE  IN  CORF  OH  ON  DRUM 


IF 

IF 


(NOO'.lwp 

(K  .6T. 


.FO.  II)  GO  TO  1?2 
(MOOUMP*HUFL£N) ) GO  TO  122 


121 
1 ?? 
124 


ADORES  s COIOP^  * (NOnuMP-l ) *HUFLEN 
CALL  RPEAtMAODPES. corps. 1. IV  "" 


IF  (IST4T2  ,E0.  1)  GO  TO 
GO  TO  124 

KK  = K - (f.Onu^P^MUFLFN) 
coops  = Awkftv (COLOR  1 ♦ 

IF  (COOES  .NF.  COLWHU)  oO 


STAT2) 

121 


- 1) 

TO  ISO 


♦ K - 1 


NOHOOOlO 

Nr>H00020 

NDH00030 

MUH0004Q 

NOHOOOSO 

NDH00060 

NDHOOOTO 

NDMOOOhO 

NUHOOORO 

NDHOOiOO 

NuHOoilo 

NOH00120 

NOH00130 

NOH00140 

NDHOniSO 

ndhooIgo 

NOHOOifO 
NDH00180 
NDHOOIRU 
NDH00200 
NOH00210 
NOH00220 
NOH00230 
NOH00240 
NOH002SO 
NOH00260 
NOH00270 
NOH002B0 
NOH00290 
NOH00300 
NOH00310 
NDH00320 
NOH00330 
NDH00340 
NDH00350 
NOH00360 
NDH00370 
NDH003B0 
NOH003R0 
NOH00400 
NDH00410 
NDH00420 
NOH00430 
NOH00440 
NDH004S0 
NDH00460 
NDH00470 
NOH004BO 
NOH00490 
NDH00500 
NDHOOSIO 
NDH00S20 
NDH00530 
MDH00540 
NOHOOSSO 
NUH00S60 
NDH0OS7O 
NDhOOSBO 
NDmOOSBO 
NDH00600 
NDM00610 
NnM00&20 
NOH00630 
A'nM00b4(l 
NDtiOObSO 
fiLlHOObbO 
NDH00670 
^'l)H006B0 
NOHflObRO 
NljMno700 
NDH0071 0 
NDM00720 
M)HOO I 30 
NOM0074n 

NOMno7so 

NDHOO/HO 

NOM00770 

MiiHonyHO 

NOHn07R0 


FIlFt  WOHST? 


l?A  CONTINUP 

rNTttl  ■ CnT'^?  ♦ R - 1 

C4I  L PPf 40(<*r,Tol,C0UMT*<»l»XSTAT) 

X?R  !F(ISTAT  .fO,  n GO  TO  12A 
COUNT®  * COI(i.!Tw  ♦ 1 
CALL  »w®ITf (CNTWl .COUuTRt 1 * 1ST ATI > 

IF<  ISTATl  .EO.  1)  GO  TO  127 
00  TO  ISO 
CONTINUE 

INSERT  NEW  Vector 

IF  (NOVEC  .LT.  MAXVEC)  GO  TO  137 
ov»FLO  8 OVCFLO  • 1 
IF  <OWPFLO  .GT,  1»  GO  TO  136 
wRITF(6,133) 
format (//////) 

WRTTF(*.123)maXVEC 

format (/t  COKE  LIMITS  EXCEEDED.  MAXIMUM 
• IS  '.16) 


1R7 

130 


ns 


133 

1?3 


NO. 


ndhoogoo 

NbMOOSlO 

ndmoobAo 

MIHO0A30 

NOhOOGAO 

NOHOOGSO 

NOHOO06O 

NOH00G70 

NOH008A0 

NOH006R0 

NOH00900 

NOH00910 

NDH009|0 

NDH00930 

NOHOO?AO 

NDH009S0 

NDH00960 

NDH00970 

NOH009G0 

OF  vectors*/*  ACCEPTEONOh00990 

NL'HOIOOO 


ns 

)-»7 

140 


14S 


ISO 

?00 


VECTOR  table  is  full— CONTINUE  TO  HISTOGRAM  DATA  VECTORS  THAT 
ALHFAOr  EXIST 

RETURN 

NOVFC  • NOVFC  ♦ 1 
no  140  L«1.SI7E 
h1ST{L.nOVEC)  8 COMkHO(L» 

CNTR1  8 CNT®2  ♦ NOVEC  - 1 
CO'INTB  8 1 

CALL  ®>*'MlTE(CnTRl.COUNTR»  1.ISTAT3) 

IF  (ISTAT3  .FO.  1)  GO  TO  145 
VFCSWT  8 1 

IF  (“FANSW  .NF.  0 .OR. 

ARRAY (C0L0R1  ♦ VECCNT) 

FONT  I Wilt 
CONTINUE 

RETURN 
FNn 


MAPKEV  .NEi 
8 COLWHO 


0)  GO  TO  ISO 


NDHOiOlO 
NOM01020 
N0h0i030 
NPH01040 
NOHOIOSO 
NOH01060 
NOH01070 
NOHOIOSO 
NDH01090 
NOHOlipO 
NOhOilU 
NOHOl ‘ ‘ 
NDMO  j 
NDHOi _ 
NDHOlISO 
NOH01160 
NOHOl 170 
NOHOl ■ " 
NOHO 
NOHOl 


0 

20 

30 

40 


filp:  PiroLR 


c* 


CSFND 


«;UBKOUTINr  PICOL-  (ID4TA««»^OFe4T*COL.<(i»D»M*lAMP.NOFtT?.HGCHAN) 
PirOLW  FXTkACf  ThF  colop  CHANNFLS  FwOH  iOATA  ANO 
PACK  THP  8 PIT  PIXELS  IfJTO  A COMPUTE^  kOhO 

IMPLICIT  INTFGEP  (A-7) 

INCLUOF  Ck’k^n.LIST 
COMMON  /NOIM/NCLPCh. 

* Cl  ASS»SIJHCLS»F  ■ 

* .CNToi,C'iTR2*J01 

* ,IOATA1«TOTVEC 


H.CLMVF.C(30>  iMAXVEC. 
FIELO»MFANSi*»NOVECtF 
l•IO^tCOLUPl«CQLON^• 


MAPKFY» 

FLDINF(6) .SI?E.T0TMNS 
»HLIFLEN»I03»COLOP3»NOOiimP 


ni“ENSION 


logical*!  _ 

FOtllVAlENCE 


100 


irTATA(l) 

LOItMlA).  LLDUM(4> 

_ (Idum.ldumii)»,(iioum,lldum(1)) 

TiniiMso 

no  100  I»1.NCLRCH 

II«k*(pgchan*I-2)«NSAMP 

lOUMxinATA(II) 

LLOOMII)  «Lf)tlM<4» 
coLw»n«iiotiM 

return 

FNH 


PICOOOlO 
P1C00020 
PIC00030 
COOOAO 
C00050 
COOOFO 
C00070 
COOOHO 

conoRO 
cooion 
COOUO 
C00120 
C00130 
cooUn 
COOibO 

.cooifro 

PIC00170 

PlCOOlftO 

PICOOIRO 

PIC00200 

PIC00210 

P1C002P0 

PIC00230 


on 


FILFt  RESTO 


C 

r* 

r# 

C* 


r*EMP 

c 

c 

1"10 

100 


r. 

c 

r 


SUOROUTINF  ‘^FSTO  (IL1NE*NSA*-R»PFGIN1) 

PERTO  RETRIEVES  THE  CLUSTER  MAP  FROM  DRUM  A LINE  AT  A TIME 

RESTOW  PICKS  OUT  THE  DESIRED  ID  FROM  WITh|N  THE  LINE 

IMPLICIT  INTEGER  <A-2» 

INCLUDE  COmok*.,LIST 

C0MMON/0L0MAL/hEAO(6?»  .MAPTAR,OATAWF»SAVTAR.!jMFlLE»PMKEYt 

RISE It.HlSKEV.TWEnWM.EKIPTP.tRRKFY.MAPUNT»NOFlLEt 
nRI)«An.nRM  ins.PAfiSl/»n»TEIL»STAEIL«ASAW»ASAVEL 
.NHSTiiN,.«iHf;TEI,SCTHUN,MAPElL 

.nOTUNTtnOTElLtfJCHPAS»TRNSFL»BHTRFL*MlSTFLtPCHUNT» 

CRDUNT.RRTUNTtWANDlO 

COMMON  /ID^nPD/  IOrOWO(IOOO) 

ADORES  * BEOINl  ♦ nLINE-n*NSAMR 

CALL  WPE  At)  ( ADORES.  IDwORU  t NS  AMp,  1ST  ATI 
IF  (ISTAT  ,F0.  1)  GO  TO  ISO 
IF  (ISTaT  ,GE.  0)  RETURN 
WRITE  (<S.  ion) 

FORMAT (•  ERROR  READING  DRUM*) 

CALL  C*'ERP 

ENTRY  RESTOR (K.NUR9) 

NUMB  = IDW0=»D(K> 

return 

ENO 


PI SuOOlO 
HES00020 
RES00030 
RLSOOOaO 
RFsnooso 
RESOOONO 
WFS00070 
RFSOOOhO 
HtSOOORO 
COMOOOlO 
CCMOOOPO 
COM00U30 
COMOOOAO 
COMOOOSO 
COmOOOAO 
RFSOOnO 
PFS00l?0 
RFSOOllO 

pf  sooUo 

RESOOiSO 

RES00160 

RESOOITO 

RESOOIPO 

WESOOIRO 

RESOOPOO 

RFSOOPIO 

RESOOPPO 

RES00P30 

RESOOPAO 

HtSOOPSO 

RESOOPhO 

HESO0P70 

RESOOPPO 

RESOOPMO 

RES00300 


Oi’Ii'iXAL  PAGE  IS 
OF  PO'  iR  (^UALFiY 


oooouo  wot;  ooo 


flLFt  SETIO 


C* 

C* 


•CUPWOUTInF  *S£T10(L1M1T) 

SETIO  READS  tHE  CONTROL  CAROS  FOR  THE  NOIM  PROCESSOR 

implicit  INTEOEH  (A-Z)  , . 

OIMENSION  COOE(10)«CARO(62)«EOUCOM(3)tACARD(20) 

data  NRUT/in/ 

DATA  F<JUCUM/;>«  . I « •/ 

DATA  RLANK/*  t/tCRCO/^C'/.FBCO/’FVtMRCO/’Mt/.PPCO/'R*/* 

1 SPCO/»S*/.UHCO/*U*/ 

DATA  CODE/ ‘CHAN*  » »OATA»  » 'MAPFt , iHlSF* • 

• tOPTPt  *OATE*»'COMM«,«HEOl*«»HED2»f»*ENO»/ 

TNCLHOE  COMRKI.LIST 
INCUIOF  COMBXA,  list 
INCLUDF  COmrka.lTST 
INCLWDF  CMfc;Kn«Li5T 

COMMON/ INFO»M/NOCLS2tNOSUR2*NOFET2»VAR|Z2iTOTVT2«NOFL 02. 

• AVA»>.C0VA«?.CLS102.SUBN0|.SIIR0S2*FLnSV’.VERTX2. 

A FFTVC2(30).SURVC2(H).SU8PTR(75).CLSVC^;'.0»  t 

• KFPPTS(60) .NOG«Pi6HPNAM(60) .GRPOEXIOl) ♦ 

• PRPCHK (61) .GROUPS (12A) 
dimension  MEm  (15)  .HEDSdR)  .OATEO)  .COMENT(IS) 
equivalence  <mE01(1).m£au(A) ).(0ATEil).MEA0?22)).  , 

9 (HEOZCl) .HEA0(30) ) , (COMENT(l) .HEAO(AR) ) 

C0MM0N/GL0BAL/HEA0(63) .MAPTAP.nATAPE.SAyTAP.BMFILE.BMKEY. 

HlSFIL.HISK£Y.TRFORH,ERiPTP.ERPKEY.HAPUNT.NOFILE. 


TFwn 


nib.  IL.MlSlvtT.  I wrUKiH.tKir-ir.cnrivcT  »cnr 

nRUMAD.nPMwnS.PAGSIZ.nATFIL.Sf AFIL.ASAV.ASAVFL 
.NHSTLIN.NmSTFI.SCTPUN.MaPFIL 

.DOTU->iT.nOTF  IL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

CROUNT  .MWTIJNT  .RANDIO 

common  /N01M/NCLHCH,CLHVEC(30) .MAXVEC.HAPKEY.,  ^ 

A CLASS.SUflCLS.FIELO.MFANSW.NOVEC.FLOlNFCA) .SIZE.TOTMNS 

> ,CNTR1»CNTP2,ID1.102.COLOR1.COLOR2.BUFLEN.I03.COLOR3.NODUMP 

► .lOATAl.TOTVEC 

INITIALIZF  parameters 


NOCLR?  a 
NOSU«?  » 
7FR0  » 0 
‘JCLPCH  a 
MEANSW  a 
MOFFT?  * 

field  a 

MAPKFY  a 

CLRVCZd) 

SUBPTR(75) 


PLANK 

e blank 


wRTTF  (#,,1110) 

100  F0OmaT(/11X. 'INPUT  SUMMARY'//) 

RETUP  reread  buffer 

CALL  REREAnoO.PO)  ^ 

•MOW  READ  The  .^FXT  C&mO  INTO  THE  BUFFER 

lOR  BF»0(?1  .IIRI  (ACAHOd)  .Ib1,20) 

:i5  FORMAT  ( ?0A#*) 

WRTTF  no.l  l^j  (ACAPOd)  .1*1,20) 

DEW  I NO  :^ll 

' RFAono,  iio)cuofci,CAHn 
CEwINO  30 

roi  a n 

vrttf  (#.,i?n)C(tnU,CARD 

170  FOOt-iAT  ( I*.  A4,(,X,0241) 

«n0  FORMAT  ( A4, 6*, A>?A1  ) 
no  130  lal.t'PtjT 
IF  (footl  .F>J.  COOEd)) 


GO  TOdSO.lPO.210.2SO.  330.370. 

390.AOO.A10.A20).! 


130  rONTINUF 

13R  WWITF (A, 1*0( 

1*0  format  ( » I'^iVALll)  CONTROL  CARD  - IGNORED  •) 
GO  TO  1*^5 


snooolo 

SFT00020 

SET00030 

SETOOOaO 

SfTOOOSO 

SET00060 

SET00070 

SETOOQMO 

SET00090 

SETOOIOO 

SETOOliO 

SETQoizO 

5ET00130 

SFTOOiAO 

SETOOISO 

imm 

setooIbo 

SETOO]  * 
SETOOj 

sCtoo! 

SETOOj 

setooL 

|ET002A0 
SET002S0 
SETO0|60 
SET00270 

liwpi 

SET00300 
SET00310 
SET00320 
SCT00330 
SET003A0 
SET003S0 
SET00360 
SET00370 
SET00380 
SET00390 
SETOOAOO 
SETOOAlO 
SET00420 
SETOOA30 
SET00A40 
SET004S0 
SET004N0 
SET00470 
SET004P0 
SET00490 
SfcTOOSOO 
SETOOSIO 
SETOOSIO 
SET00530 
StT00540 
SETOOSSO 
SFT00S60 
SET00S70 
SETOOSPO 
SET00S90 
SET00600 
Sf T00610 
StT00b20 
SFT00G30 
SETOObAO 
SfcTOObSO 
Sf TOOGSO 
Sf TOObTO 
SETOObPO 
SfT00b90 
SfTOOTOO 
StT00710 
SFT00720 
SET00730 
SET00740 
SfTOOTSO 
SETO0760 
Sf  T00770 
Sf  TOOTHO 
SET00790 


JXI4  -'ru_:(3AL  PAOt  la 

t PCCti  QUALfTY 


FILPJ  SETIO 


CMJt^NEL  CANO 


ET9t)ttflO 


M«NKTCH4(C< 
IF  .FO. 
TF  (N  .FO. 
tF  .FO. 


COLiCLRVECtNCLRCM) 


lUft  M«NKTCH4(CAFO*rOL) 

•“  GO  TO  105 

PHCm  00  TO  160 

..  , CHCOI  60  TO  170 

m6ttf(6.i^%) 

format  I • ERROR  ON  CHANNELS  CARO*) 

60  TO  US 

iNfi  J • FIN01?(CaR0»COL«C0UC0H) 

TF  ( J .NF.  ) GOTO  153  . 

NOFFT?  • N0*'«ER<CAMD.C0L*FETVCEtN0FET2) 
COL  * rOL  - 1 
CALL  0»nER<FETVC2.N0FET2) 

60  TO  ISO 

170  J ■ FIN012<CAR0.C0L»EQUC0M) 

TF  «J  .nF.  ? > 60  TO  153 
NCI  RCH  ■ Ni)HKERICARO*CC 
roL  « roL  - I 
CALL  OROEMICLRVECtNCLRCHl 
60  TO  ISO 

OATA  FILE  CAHO 

1«0  M s NkTCHR(C4WP,C0L) 

TF  (H  .€0.  HLANK)  60  TO  105 
TF  (o*  .EO.  IHCO)  60  TO  UO 
TF  <-  .FCl.  FPCO)  60  TO  200 
1 AS  WQTTF  (S,  1<)7» 

1*7  FORMAT  I*  EkNOR  on  OATA  FILE  CARO*) 

60  TO  10^ 

ion  J o FIN012(f,MR0tCOL.E0UC0M) 

»F  (J  .NE.  ?i  GO  TO  Tbs 
K s NI|MpFP(CiRn.COL»UAT< 
cni  X rOL  - 1 
60  TO  iRfl 

■ I X F lfjDl2ir  4MO*COL.EOOCOM) 


UPf  .ZERO) 


200 


TF  I . vF.  ? ) 60  t6  IMS 
M s U'IJMHFw  (CftPn.COL.OATFIL.ZERO)- 
OATFIL  X OaTfil  - 1 

roi.  X COL  - 1 


r 

C 

c 


21  0 


60 

TO 

IMC 

CLtlSTl; 

R/CI.aSSIFIC 

ATI 

On  I 

M s 

(TCnW 

(C4P0.C0L) 

TF 

(M 

.FO. 

Ml  ANK) 

GO 

TO 

TF 

(*• 

.FO. 

U'CU) 

60 

TO 

IF 

(*■■ 

,F  0. 

R-CO) 

60 

TO 

I OS 


U'W  I I ► 

P7n  rnoi^trc  ERWOw  on  OAS  FILF  CARO*) 
60  T6  1(,S 

?3n  J X FINOlPICiRn.COL.EOUCOM) 

IF  ( J .T> . »)  GO  TO  21S 
M ■ NtiMHFR(CAKr).COL.MAPUNT.ZERO) 
MAOKfY  X 1 
cm  X roL  - 1 
60  TO  ?1(1 

?4t)  J X F TM|-)12(r-4PO.COL.EOUC0M) 

IF  (J  .*F.  /y  GO  TO  21S 
He  NUMPf  RICAPO, COL. MAPFIL. ZERO) 
M40F IL  = MAOFIL  -1 
roL  = roL  - 1 
60  TO  210 


(o:i(;i;:AL  page  ib 

Or'  I'.  ^ i:  quALlTV 


r 

N-niM 

HI 

ST< 

*<'l.  AM 

FILE 

c 

3S0 

M B 

«TC 

(C4W0, 

COL) 

TF  (M 

.F 

i. 

SI  AN'K 

) GO 

TO 

los 

IF  (M 

'"CO) 

Go 

TO 

270 

* 

IF  (M 

• E 

'J. 

Ft'CD) 

60 

TO 

2S0 

psn  WRTTF 

format  (•  ON  N-OIM  mISTOGmAM  file  CARO*) 

60  TO  1 IS 

?7n  .)  s FTNOIR'C jen.COL.ETUCOM) 

TF  (.)  ,t>.  FI  GO  TO  ?M0 

M s NfiM'.F-,  (0 'Mn.COL.NHSTUN.ZFROl 

roi  = C''L  - 1 

60  TO  ?S0 


j?s§s!| 

SETOOOOT 

SETOOSli 

SET009?( 

SET0093t 

sItoovao 

SCT009SO 

S|T00960 

SET00970 

SFT009RO 

SET05990 


SETO 

sIto 

m 

SETO^ 
SETOI 
SETO 
SfcTO 
SETO 

sno 

SETOI 
SETO 
SETO 
SETO, 
SET01300 
SETO  ' 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETO 
SETT 
SET!  . 
SETO 
SETO) 
SETOI 
SFTOl 
SETO 
Sf  Toi 
SFTOISAO 
SFTOisSO 
SFTOlSMO 
StTOlSTO 
SFT01S80 


FILE!  SETIO 


2«A  J ■ F1N012(C*hO*COL*EQUCOM) 

M^>  *NUmSeA  (C«RD*Soi.?NHt?n  «ZERO) 

88So8r‘ 

OPTION  CMO 

M ■ NXTCHPtCAROtCOL) 
r (M  ,f<5.  MLPN^)  W)., 
r (H  ,|0,  C^tCOI  60  Tt 
r (N  .to.  5PC0>  60  T( 

F CM  .10.  FhCO)  60  T( 

F (M  .CO.  **NCO)  60  TC 

FoiMllM^ISpOR  ON  OPTION  CARD*) 
60  TO  105 


330 


1 


340  _ 

36? 

360  6U6CLS  » I 
FIFLO  • 0 
GO  TO  365 

56^ 

343  MCANSW 
366  • 


j“»  FiNOl2(C/'ROfCOL»EOUCOM) 

TF  ( J .EQ.  3)  g5  t6  330 
IF  ( J .EU.  •!)  QO  TO  l05 

DATE  CARO 

370  M > NXTChR (C4H0.C0L)^  

IF  « M ,E0.  BLANK)  GO  TO  105 
PC40(30.3‘*0inATE 
360  FOPMaT { lOX . 15A4) 

PEMjNO  30 


GO 


105 


360 


COMMENT  CARO 

M s NXTCHH (CAPO.COL) 

TF  (M  .FO.  PLANK)  60  TO  105 
RFAO(30.3B0)C0MENT 
PEWINO  30 
GO  TO  105 


400 


C 

■c 

C 


) 30 
105 


410 


4?0 


c 

c 


MEDl 

M c NXTCHR CCARD.COL) 
PEAO(30.3«0)  HEOl 
pEwIND  “ 

60  TO  ■ 

HE02 

R m NXTCMR(CARD.COL) 
PfAO(30.3t«0)  MF02 
PFWINO  30 

GO  TO  105 

•END* 

CONTINUE 

ST7E  « NOFFT?/* 

TF  (xon(NOFET2.4)  ,NE. 
MAXVEC  » LlMlT/SIZt 


0)  SIZE  » SIZE  ♦ 1 


WPTTF(A.IoOO) 

TF  (NGFfT2  .NE. 
(NCL^CH  ,NF. 
(MARKET  .^U. 
(CLASS 

(6UUCL5  .F'J. 
(FIFLf)  .F'J. 
(ME  ANS  ^ .E 


TF 

TF 

IF 

IF 


0) WRITE (6.1010) IfETVC?  1) .l»l.N0FET2j 

0)  WRITE (6.1020) (CLPVEC(l) •i«l«NCLRCH» 

1)  wRITt(4,l030) 

1 )wRITF (6.1040) 

UwRITE  (6.  1050) 
l)kPlTF(6«1060) 
nwwnE:(6,io7o| 


-IV,  WT, 

•TO  “ 


ITT 

138 


lTOUaO 


■T018AO 
1690 
1900 


m 


1000  format (//•  USER  HAS  MfriuESTEO  THE  FOLLOWING  OPTIONS  !•/) 


SET01950 
SET01960 
SET01970 
SE.  TO  1980 
SET01990 
SET02000 
SET02010 
SET02020 
SET02030 
SET02040 
SFT02050 
SET02060 
SET02070 
SET02080 
SET02090 
SET02100 
SET02110 
SET02i20 
SET02130 
SET02140 
5ETO2150 
SET02160 
SFT02I70 
SET02180 
SET02190 
SET02200 
SET02210 
SET02220 
5ET02230 
StT02240 
SET022S0 
SE;T0?260 
SET02270 
SET022B0 
SET0P290 
SET02300 
SET02310 
SE  T02320 
SE  T02330 
SFT02340 
SETti^iSO 
SETOP.-^O 
SET02370 


1^16 

0^7 


riLft  SCTIO 


ioto 

jOAO 

1070 


roP«4T(« 
rOPM4T « • 
roPMaTi* 
ropMaTf 
roPMaTi • 
FOPHATC* 
F0PP4T<» 
PETUPN 

END 


HiSTOGHa**  DATA  VECTORS  EROM  CHANNELS 
COLOR  COOES  ARE^EROP  CM|NNCLS  **4  ‘ 

iFfCATiON  Tape  is  be 

RY  CLASS'!, 
it  lyBCLASS*) 

ON  PER  EIELOS  BASES') 
INPUT  EIELOS') 


Istogram  eIelos 

STOGRAM  ElELDf 
}HPUTE  MEANS  Of 


ELS  '«1'G(I2*1X)) 

iNS'lNUT') 


Oi{ 

Ol’ 


] 


riLF:  STOOAT 


c»ENn 


SUBROUTINE  ST0DAT(lLlNEfNSAMP«HlST*LlMITtBE61Nl) 

STODAT  READS  AND  STORES  THE  CLASSIFICATION/CLUSTER  MAP  ON  DRUM 

IMPLICIT  INTEGER  (A-Z) 

TNCLUOF  COMRK#>.LI*iT 

COMMON/GLO»AL/HEAn(63»  »MAPTAP»OATAPE»SAVTAP*BMFlLEt0MKEV»^. 

MlSFIL.HlSKEY»TRFORM»ERIPTP»ERPKEY»MAPUNT»NOFILFt 
nRU‘^A0.f)RMJ0S.PA6SIZ.nATFIL*STAFlLtASAV#ASAVFL 
•NHSTUNtNHSTF 1 ,SCT«UN»M*PFIL 

.OOTUivlT.OOT^  IL.NCHPAS»TRNSFLfBMTRFL»HISTFL»RCHUNTt 
CROUNT*PRTUNT.RANOIO 

DIMENSION  HIST(LIHIT)«FETVEC(1)*FL0(6)«NLINE(4> 

TOTWRD  s ILINE*NSAMP  . “ 

IF  (TOT*#RD  .LE.  (DHMWOS- (0RUMA0-BE6IN1 ) ))  60  TO  120 

format (•  NOT  ENOUGH  DRUM  SPACE  TO  STORE  OAS  TAPE  DATA*, 

CALL  CMERR 

CALL  TAPHOR(MAPUNTtMAPFIL) 

FETVECU)  « 1 

NOFEAT  si  , 


FLHd)  = 1 


FLD(?) 
FLD(3) 
FLrt(4) 
FLn(«?) 
FLR(f>) 
pERIN  ! 


iline 

1 

N5AMP 

BEGINI 


CALL  FLOINT(FLO  ,FETVEC. NOFEAT) 

PUMPS  s TOTWPO  / LIMIT 

IF  (MOD (TOTwPU. LIMIT)  .NE«  0)  DUMPS  « DUMPS  ♦ 1 
TOTLNS  s LIMIT  / NSAMP 
IF  (TOTLNS  .G£.  ILINE)  60  TO  lAO 
PMP  s DUMPS  - 1 

no  l?n  isi.DMP 

NLINF(I)  = TOTLNS  ^ 

NLINE (DUMPS)  s iline  - TOTLNS*DMP 
RO  TO  ISO 

NLINE  (1)  s ILINE  . - 

00  POO  Js), DUMPS 
NUMLIN  s NLINF(J) 

00  IftO  Ksl, NUMLIN 
WORDS  = NSAMP* (K-1) 

CALL  LINERD(hIST(WOROS*l) tENDTAP) 

STORE  ON  HIGH  SPEED  DRUM  . 

NWORDS  s WORDS  ♦ NSAMP 

CAI L RW«ITE(RE6IN.HIST(l)tNW0RDS*lSTAT) 

BEGIN  r BEGIN  ♦ NLINE(J)  • NSAMP 

MAPFIL  = MAPFIL  ♦ 1 

return  _ . 

END 


STOOOOlO 

ST000020 

ST000030 

ST000040 

ST000050 

ST000060 

COHOOOlO 

COM00020 

COM00030 

COH00040 

COM00050 

COH00060 

STOOOOBO 

ST000090 

STOOOlOO 

STOOOllO 

ST000120 

ST000130 

STOOOUO 

STOOOISO 

ST000160 

ST000170 

ST000180 

STOOOIRO 

ST000200 

ST000210 

ST000220 

ST000230 

ST000240 

ST000250 

ST000260 

ST000270 

STO00P80 

ST000290 

ST000300 

ST000310 

ST000320 

ST000330 

ST000340 

ST000350 

ST000360 

ST000370 

ST000380 

ST000390 

ST000400 

ST000410 

ST000420 

ST000430 

ST000440 

ST000450 

ST000460 

ST000470 

ST000480 

ST000490 

ST000500 

ST000510 

ST000520 

ST000530 


IS-- 18 


w 


I 


FILF»  WRTFIL 


SUBROUTINE  WRTFIL  (HIST tHEANS«IOtCOLOR*FIELOSt VERTEX** II 


WRTFIL  NRITFS  THE  NOIM  FILE 


CSEND 


IMOLICIT  INTEGER  (A-Z) 

INCLUDF  COMbKI.LIST 
INCLUDE  COMRKA*LisT 
TNCLUnE  CMijKll.LlST 

COMMON/lNFORM/NOCkS2.NOSUP?*NOFET2.VAR5ZZ*TOTVT2»NOFL02* 

, AVAP?.C0VA«?«CLSI02»SURN0|.SUPnS2*FL0SV2*VERTX2» 
FETVC2(30) .SUbVC2(7S) .SU8PTR(75) *CLSVC2(60) * 
KEPPTS(f>0)  *N06RP*6HPNAM(60)*6RR0EX(61>* 
GRPCHKdSl)  *6R0UPSI12A) 

C0MM0N/GL08AL/HE*n (fi3) *MAPTAP*0ATAPE*SAVTAP*BMF1LE*BHKEY* 

HISFIL»HlSKEV.THFORM*£RIPTPf£RPKEY»MAPUNT*NOFlLE* 
DPU«AD*DRM-*DS.PAGSI2tnATFIL»STAFIL»ASAV.ASAVFL 
.NHSTUNtNWSTPI.SCTRIIN.MAPFIL 

.OOTUmT.[)OTFIL*WCHPAS*TRNSFL*BMT«FL*HISTFL*PCHUNT* 
CRnUNTfPHTUNT.RANDIO 
common  /ND1M/NCLHCH.CLRVEC(30) *maxvec*mapkey* 

CLaSS.SUBCLS.F1EL0*mEANSW*N0VEC*FLDINF(6) *S1ZE*T0TMNS 
»rNTRl,CNTR2,lDltlD2*COLORl«COLOP2*BUFLEN*ID3*COLOR3*NOOUMP 
,IDATA1*T0TVEC 


I 

c 


niMFNSTON  HIST (1) *MEANS(1) *ISTAT(4) tlD(l) *COLOR(l) *VERTEX(2*1> 
DIMENSION  FIELOS(4*l.) 

PEAL  MEANS 
DATA  BLANK/*  •/ 

I = I ♦ I 

IF  il  .GT.  1)  60  TO  100  


WRITE  header  RECORD 


C 

c 

c 

c 


WRITE  (NHST‘.J*M)  T0TMNS*SIZE.N0FET2*  (FETVC2 ( I ) ♦ I»1  *N0FET2)  ♦ 
• NCLPCh* (CLRVEC(I) flalfNCLRCH) 

ENDFILE  NHSTUN 


100 


WRITE  RECORD  1 

WRITE (NHSTUN)  N0FLD2»N0SUP2*T0TVT2»N0VEC 
WRITE  RECORD  2 


C 

c 

c 


WRITE (NHSTUN) 

► I 


CLSVC2U) . <SUBVC2(1)  *I*1*N0SUP2)  * ( (FIELDS (1 


_ _ ^ I«J). 

1.4) *jsl ,N0FLD2)* ( (VERTEX (I *J>  *1«1*2> ♦J«l.T0Tvt2) 


C 

C 

C 


WRITE  RECORD  3 - 
IF  (TOTmNS  .GT. 
WRITE  RECORD  4 


0)  WRITE (NHSTUN) (MEANS ( I ) ♦ I«1 *T0TMNS) 


II  s ST7E*NOVEC 
WRITF(NHSIUN) (HIST (I) .1=1.11) 


C 

C 

C 

C 


IF  (NODUMP  ,EO.  0) 


READ  ID  INFOKMATION 
WRITE  RECORD  S 


GO  TO  160 
INTO  CORE 


no 

ns 

120 


T 

C 

C 


VECDRM  s N0DUMP*PUFLEN 

VFCARY  s NUVFC  - VECDRM 

CALL  RPE»0(ID3.HIST(n .VECDRM, ISTAT ( 1 ) ) 

IF  (VECARY  .EC).  0)  GO  TO  115 

DO  no  1 = 1. VECARY 

HIST (VFCOHM*! ) » 10(1) 

CONTINUE 

IF  (ISTAT(l)  .E(T.  1)  60  TO  120 
“ 1 = 1.N0VEC) 


WRITE (NHSTUN) (HlST(l) .Is 
WRITE  REC  6 


12S 


CALL.RRFAD(tNTR?,HIST (^) »N0VEC.1STAT(3) » 


C 

C 

C 


IF  (ISTaTO)  .PfJ.  1)  6 
WRITF (NHSTUN) (HIsT(I) .1 


TO  125 
sl.NOV" 


VEC) 


WRITE  REC  7 


WRTOOOlO 

WRT00020 

WRT00030 

WRT00040 

WRTOOOSO 

WRT0OU60 

WRT00070 

WRTOOOPO 

WPT00090 

WRTOOlOO 


WRTOOllO 

WRT00120 


WRT00130 

WRT00140 

WRT00150 

WRT00160 

WRT00170 

WRT00180 

WRT00190 

WRT00200 

WRT00210 

WRT00220 

WRT00230 

WRT00240 

WRT002SO 

WRT00260 

WHT00270 

WPT00280 

WRT00290 

WRT00300 

WRT00310 

WRT00320 

WRT00330 

WRT00340 

WRT00350 

WRT00360 

WRT00370 

WRT00380 

WRT00390 

WRT00400 

wrtooaIo 

WRT00420 

WRT00430 

WRT00440 

WRT00450 

WRT00460 

WRT00470 

WHT00480 

WRT00490 

wRTOOSOO 

WRT00510 

WRT00520 

WRT00530 

WRT00S40 

WRTO0550 

WRT00560. 

WRT00570 

WRT005PO 

WRT00590 

WRT00600 

WRT00610 

WRT00620 

WRT00630 

WRT00640 

WRT00650 

WRT00660 

WRT00670 

WRT006P0 

WRT00N90 

WRT00700 

WRT00710 

WRT00720 

WRT00730 

WRT00740 

WHT00750 

WPT00760 

WRT00770 

WRT00780 

WRT00790 


A 


r»r>r>  o ooo  nor>or>r> 


FILFS  wrtfil 


TF  CTOTKN*;  .NF*  0)  60  TO  160 
U (NCLRCM  ,FO.  0)  GO  TO  160 


' »LL  »PE#D(COLOw3,MlST(l)«VECORM*ISTAT<2n 

_ 


F <VFCARY  .FQ.  0) 
no  130  I»1,VECA«Y 
no  MlST(VFCO«M*n  » color  (I> 
ns  IF  (ISTAT«2)  ,F0,  1)  60  to  135 
lAO  WRITE (NHSTUN) (HIST(l)*I»l,NOVEC) 
60  TO  180 


INFORMATION  DID  N(5t  NEED  TO  BE  STORED  ON  DRUM 


RECORD  5 

160  WRITE(NHSTUN) (ID(I) «1>1«N0VEC1 
RECORD  6 


HISTOGBAM  information  IS  ALWAYS  STORED  ON  HIGH  SPEED  FRUM 

16S  CALL  oRFAD(CNTR2,HIST(1)  .NOVEC«ISTATOn 

170  IF  (ISTATO)  .FO.  I)  60  TO  170  _ . 

WRITE (NHSTUN) (HIST (I) »1«I»N0VEC) 

WRITF  REC  7 - - 


IF  (TOTHNS  .NF.  0)  GO  TO  160 

IF  (NCLRCM  ,GT.  0)  WRl TE (NHSTUN J (COLOR ( I ) » 1*1 »NOVEC) 


160  FNHFILE  NHSTUN  . • . 

WRITE  file  INFO  ON  LINE  PRINTER 

CALL  W0TFLD( FIELDS. VERTEX, N0FL02t 2. CLSVC2*SUSVC2) 


WRT 7F( 6,100) TOT VEC.NOVEC 

IQO  FORMAT (////SSX,  ‘TOTAL  NO,  OF  VECTORS  IS/ABX. ‘TOTAL  NO. 
*UE  VECTORS  S', 16) 


TF  (TOTsNS  .EO.  0)  RETURN 


WRITF (6,200)  (BLANK,CLRV£C(I> ,l*l,NCLOCH) 

200  FORMAT (////T60, ‘FIELD  MEANS ‘//TAA,4 ( A1 , ‘CM ( • , 12, ‘ ) ‘ ,5X) ) 


WRTTE(6,210) (MFANS(I),Ii 
210  format (Ta4,4 (F7.2,5X) ) 


l.TOTMNS) 


RETURN 

END 


WRTU0t3uU 
WRT00810 
WRT0062 
WRT00630 
WRT00840 
WRT008S0 
WRT0086P 
WRT00670 
WRT00880 
WRT00890 
WRT00900 
WRT00910 
WRT00920 
WRT00930 
WKT00940 
WRT00950 
WPT00960 
WRT00970 
WRT00980 
WRT00990 
WPTOIOOO 
wRToi 
WRTOi 
WRT01030 
WRTOI 040 
WRTOIOSO 
WRT01060 
WRT01070 
WRT01080 
WRT01090 
WRTOllOO 
WRTOlllO 
WRT01120 
WRTOI 130 
WRT01140 
WRT01150 
WPTO|160 
WRT01170 
WRTOI 180 
OF  UNlOWRTOilRO 
WRT0!200 
WRT01210 
WRTOI 220 
WRT01230 
WRT01240 
WRTOI 250 
WRTOI 260 
WRT01270 
WRT01280 
WRT01290 
WRT01300 


16 


SCTRPL  PROCESSOR 


FILF!  SCTPPL 


C* 

c 

c 


•SUBRnUTINF  <;rTRPL(ARRAY»TOP) 
IMPLICIT  INTFC-FH  (A-Z) 

5CTRPL  IS  The  DRIVER  FOR  THE 


C 

C 

C 

C 

C* 

C* 


SCATTER  PLOT  PROCESSOR 


CSEWD 


DATA  LIwIT/lZOOO/ 

TNCLi.'OF  COmhki.LIST 

INCLUOF  C*hx12.L1ST 

COMMON/ 1NFOhm/NOCLS2»NOSUB?.NOFET2*VARS7?»TOTVT?.NOFL02*  _ 

AVAW?«C0VAH?*CLSID2»SUPN02*SURnSZ»FL05V?.VERTX2# 
FETVC2C30) *SUHVC2(7B) .SURPTW(7S» .CLSVC2(60) ♦ 
'KFRPTS(60>  »NOG«M.6RPNAM(ftO) *GRPDEX(6l) • 

PBRCHK (61) ♦GROUPS (124) 

COMMON/SCTTPP/RSCftLF#XYSCLF»CLRVt'C(30>  ♦NCLPCH.CLRKEYtLOGt 
FRFO.>MaX.Y''»AX#XMlN,  YMlNfMCKGNO^XHl  fXLO^YLOfXSIZ* 
YHI^YSIZ.NBINs.syMmTX (3?) ♦PmaTRX (60) .8VFC{30) ♦NPVCMN»NOFEAT 
♦SCaLKY^HFNAO«#FLnftOR#PNTAORtlOADR.NCtRMFEAT#BMCOMB 
♦NOVEf“,TOTMNS#5IZE.OHMlO,ORMl01#ORMCLRfORMCRl»ORMTNS»ORMTNlf 
ORMCNTtOR^'CT)  ♦OR'^VECtDRMVC  1 ♦ VECTRl  *DAT  A 1 ♦NVEC»NOREAO»LReAO 
,nRMPTR%DRMPTIfFETVEC(16) ♦DRMPLTtCSCALE 
♦NOSUB 

niMENSION  AftRAY(l) fBUFF(12000) 


2f* 


C 

c 

c 

c 

c 

£ 


3A 

100 


SCTOOOlO 
SCT00020 
SCT00030 
SCT00040 
SCTQOOSO 
SCT00060 
SCT00070 
SCT00080 
SCT00090 
SCTOOlOO 
SCTOOllO 
SCT00120 
SCT00130 
SCT00140 
SCT00150 
SCT00160 
SCT00170 
SCT00180 
SCT00190 
SCT00200 
5CT00210 
SCT00220 
SCT00230 
SCT00240 
SCT00250 
SCT00260 
SCT00270 
SCT00280 
SCT00290 
SCT00300 
SCT00310 
SCT00320 

SCATTR (ARRAY (FLO ADR) ♦array (VERTX2) ♦ ARRAY ( VECTR 1 )♦ ARRAY (MENADRSCT00330 
BUFFU)  ♦HUFF(  1)  t ARKAY(DATAl)  ♦ TOP  ♦LIMIT  ♦ BUFF  ( 1 ) ) l£l993iS 

SCT00350 

PROCESS  another  file  1cT00370 

GO  TO  10  ■ SCT00380 

^ 5CT00390 

SCT00<»00 

sew  c.no 

BEAD(21^100)CARO  i£I22^?S 

format (A4)  IEtOOaIo 

return  l£I22?§2 

ENO  SCt00470 


:ALL  sat  11 (ARRAY (1) ♦array <1) ♦BUFF(l) ) 
COMPUTE  ADDRESSES 

10  CALL  SETADR(«k20^^30fTOP^8UFFfLIMIT) 


SCaTTR  is  the  maim  driver  FOR  CREATING  THE  SPECTRAL  PLOTS 

CALL 

♦)  ♦ 


orso 


FILE:  CLRCOO 


SU8P0UTINE  CLRCOO < IBt MEANS* lOATAt IPOSTN* II) 

IMPLICIT  INTEGER  (A-Z) 

PEAL  MEANS! 1) 


8 

C 


INCLUOF 


COMPKI.LIST 

CMBK12,l!sT 


^OMMON/1NFOPH/NOCLS2*NOSUB? 


SUB?.NOFETZ*VABSZ?*TOTVT2.NOFL02*  „ 
AR2.CLSID2*SUBN0|.SUB0S2*FL0SV2*yERTX2i 
> *SU8VC2(75»  «SUBPTR(75) *CLSVC2(60) * 


CSEND 

C 


niMENSlON  inATA(J) 

LOGICAL*!  L 

EQUIVALENCE 


LDUM(4) ,LLDUM(4)  . .. 

~ (I0UM,L0UM(1) ) « (IIOUH*LLDUH(in 


IF  (CLPKEY  .NE.  3)  GO  TO  50 

COLOR  COOES  (RAOIANCE  VALUES)  ARE  COMING  FROM  N-OIM  MIST  FILE 


) ♦ IB  - 1 
ATI) 


COL  ADR  = DRMCLR  ♦ NVEC*(M-1 
CALL  RPEAO(COLAOR.CODEil*ISt 
105  IF  (ISTATI  .EQ.  1)  60  TO  105 

linuMso 
lOiiMscnoE 
DO  10  I»1*NC 
III»XSI7*(I-1)*IP0STN 
LLnUM(^^)rLOUM(lJ 
10  IDATAdIDallOUM 

RETURN  ' 

COLOR  COOES  (STaT  MEANS  OR  USER  INPUT)  ARE  STORED  IN  CORE 

50  IDADR  e OHMIO  ♦ NVEC*(II-1)  ♦ IB  - 1 
CALL  RPEAO(IDADR*IDNUM*ltISTAl) 

55  IF  (ISTAI  .FO.  1)  GO  TO  55 

DO  80  lal.NC  . 

Ill  » IPOSTN  ♦ XSIZ*(I-1) 

JJ  » (10NUM-1)*NC  ♦ I 
8ft  lOATA(tll)  « MEANS(JJ)  ♦ 0.5 
RETURN 
END 


CLROOOlO 

CLR00020 

CLR00030 


AVAR2,COVAR2  _ 

FETVC2<30)  .SU8VC2 

KFPPrS(80) *N06RP*6RPNAM(60) *6RP0EX(6l) • 

- 6RPCHK (51) .GROUPS (124)  ^ 

COMMON/SCTTFR/RSCALF.XYSCLE.CLRVEC(30)*NCLRCH*CLRKEY»L06* 

FREO.XMAX.YMAX.XMIN.YMIN.BCKGND.XHI.XLO.YLO.XSIZ.  ^ , 
YHI,YS1Z*NHINS.SYMMTX(32)  .BMATRX(GO)  .BVECOO)  .NBVCHN.NOFEAT 
«SCAL5Y.MEN40H,FLn40R»PNTApR*IQADR»NC»fiMFEAT.BMC0MB  ^ . 

.NOVEC.TOTMNS.SIZE.ORMID.DRMIDI.ORMCLH.ORMCRI .ORMTNSjORMTNl* 
ORMCNT.DPMCTl»DRMVEC.DRHVCl»VECTRi.OATAl«NVEC.NOREAO»LREAO 
.ORMPTR.DRMPT I .FETVEC (16) ,ORMPLT*CSCALE 
♦NOSUrt 


:lrooo60 

‘LR00070 

‘lrooobo 

CLR00090 
CLROOiOO 
CLROO] 
CLROO 
CLROO 
CLROOl 
CLROO 
CLROO 
CLROOl 
CLROOIBO 
CLR00I90 
CLR00200 
CLR00210 
CLR00220 
CLR00230 
clRoqIao 
CLR0C250 
CLROOfGO 
CLR00270 
CLR00280 
CLR00290 
CLR00300 
CLR00310 
CLR00320 
CLR00330 
CLP00340 
CLR00350 
CLR00360 
CLR00370 
CLP00380 
CLP00390 
CLR00400 
CLR00410 
CLR00420 


CLP00430 

UNPACKEOCLR00440 

CLR00450 


CLR00460 

CLR00470 

CLP004BO 

CLR00490 

CLR00500 

CLROOSlO 

CLR00520 

CLR00S30 

CLR00540 


, PAGE  IS 

c f PCCR  QUALITY 


FILFt  CLWKYS 


SURHOUTINE  CLftKYS(XSIZflOATAtNOSUB2fCH«HEANS*NC) 


C* 

C 


C 

C 


CLBKYS  ADOS  THE  COLOP  KEYS  TO  A UNIVERSAL  FORMAT  TARE 
THE  COLORS  ARE  OUTPUT  AS  SQUARES  IMAGES  (10X10) 


IMPLICIT  INTEGER  (A-2) 
REAL  MEANS (NCtNOSUBZ) 

DIMENSION  lOATA(XSIZtCH) 

0 ' 

0 

^§1 


LSTLIN  ■ 
LINE  ■ 0 
TOTKFY 


NKEYS  « XSIZ/ll 
NOKEY  * NOSUBZ 


C* 

C* 


90 


C 

C 


mo 


no 


DO  100  J>1«CH 

WRITE  A SCAN  LINE  OF  ZEROS  • USED  FOR  SEPARATING  THE  THE  COLORS 
DO 


. - ion  lal.XSIZ 
IDAtA(I«J)  > 0 


CALL  WRTLNdDATAfLSTLIN) 
LINE  ■ LINE  • 1 


IF 

KK 


(NKEYS  .LE.  NOKEY) 
B 0 


NOKEY  « NKEYS 


C* 

C* 

C* 


1^0 

140 


150 


mo 


no  150  mi, NOKEY 

TQTKEY  ■ TOTKEY  ♦ I 
DO  UO  v»«l,NC  . 
no  130  K»1.10 

KK  s (I-l)*ll  ♦ K 
1DATA(KK,U)  * MEANSCJ, TOTKEY) 
CONTINUE 

WRITE  A SCAN  LINE  OF  COLORS 
CONTINUE 

NOKEY  « N0SUB2  - TOTKEY 

no  160  1*1,10 

IF  (NOKEY  ,LE.  0 .AND,  I ,EQ, 
CALL  WRTLN( lOATA, LSTLIN) 

LINE  = LINE  ♦ 10 

IF  (NOKEY  ,LE,  0)  60  TO  170 

GO  TO  90 


♦ 0,5 


10)  LSTLIN  > -1 


170  CONTINUE 

WRITE (6,200)LINE 
200  FORMAT (/T54, 'COLOR  KEYS 

return 

ENn 


■ 'fl4,»  LINES*) 


FILFI  CNTER 


SUBROUTINE  CNTER (IB* IDATA* IPOSTN* I 1 tCOUNTR) 
IMPLICIT  INTEGER  (A*Z) 

JoSh8N/sET?Fi/RkiALE*XYSCLE.CLRVCC(30»*NCLR( 

* FRfO*X»AX.YM*X.X»cTN*yMTN*bCKGND*XMI*XLOiYI 
» YHI.YSIZ.NRINS.SYMMTXO?)  *RMATRX(«0)  ♦IvEC 


HNvNOFEAT 


«DR«FL0ADRfPNtA0R*!0ADR*NC*8MFEAT*BMCgMR 

►'NS  ♦ S I ZE  ♦ ONM 1 0 . ORM  i 6l « OMMCLR  ♦ OMMCR 1 . ORMTNS  ♦ ORMTNl 

i*ormvcc*drhvci*vectAi*oatai*nvec*noreao*lreao 


«NOVEr*TnT»'NS*SIZE*ONHIO*ORMigi«ORHCLf 
0RMCNT,DM«CT1*CwmvEC*DRmVC1*VECTP1.0ATA] 
.*  ORMPTR  * ORMPT I ♦ FET  VEC ( 1 6 » ♦ ORMPLT • CSC ALE 
•NOSUR 


DIMENSION  IDATA (n 
COMPUTE  DRUM  ADDRESSES 


CTRADR  « NVEC»  (1 1-1)  ♦ IB  ♦ DRMCNT  - 1 
CALL  PRFAD(CTRAOR.COyNTR*l,|STATl) 

IF  TISTATI  .EQ.  I)  GO  TO  ioS 

THE  VECTOR  COUNTER  IS  THE  LAST  CHANNEL 

I • XSIZ«NC  ♦ IPOSTN 

IF  (CbUNTR  .6T,  255)  COUNTR  ■ 255 

IDATA  (1)  « COUNTR 

RETURN 

END  


CNTOOOIO 

JUSSIS 

CNT00040 


CNTOOIO 

km 

CNTOO 
CNTOO 
CNTOO 
CNTOO 
CNTOO 
CNTOO 
CNTOO 
CNTOO 

CNTOO 
CNT00240 

cnIo^IIo 

CNT00270 


ir-4 


riLri  LINPLT 


SUBROUTINE  LINPLT 

There  arc.?  ^nts 
1,  subroutine  li 

i,  ENTOT  STOPTS 


ENTRIES. t 
“ .INPLT  - 


- ^MPUtII  TmI  58|i??ON  OE  THE  PIXEL  ON  THE 
••2^MIJ§T^2r*?2LLM*rOB  EVEBV  PIXEL  ••• 


3,  ENTRY  PRTPLT 


•••  pu8t^Se*8Sll|S  eor  every  pixel 

PRINTS  the  plot  ON  THE  LINE  PRINTER 
PIXEL  MUST  BE  POSITIVE  ••• 


IMPLICIT  INTEGER  (A-2) 

real  sumi»|6unt»l6g^ 


REAL 


ALE.YSHETtSCALEYtSCALEXfSHETY.SHETX 
DIMENSION  YAXiSdl)  tXASlSai) 

INCLUDE  COH«k*,L1ST  ... 

INCLUDE  COMR<»>.lIsT 
TNCLUOE  CMaK12«LIST 
dimension  nEOl (IsffHE02(15) *0 

fouIvalence  <HE0i (p ,MEAftuh 
2 <MEp2<l>tMEAU(30i 

COMMON/GLORAL/HEAO(63>  *MAPTAP 
M!SFIL»m|SKEY»"“ 

OPUMAO.nRMwOS.PAGSIZfDA  __ 
.NHSTUN.NHSTEltSCTHUNfMAPFIL  . - « 

.OOTUNT.OOTFlL.NCHPAS*TRNSFLtBMTREL*MISTEL»PCHUNTf 
CRDUMT.PRTUNT»RAN010 
COMMON/SCTTFR/BSCALEf XYSCLE»CL»VEC(3ft) *NCLRCMtCLRKEY#L06t 
FRFO,Xi»AX«VMAX,XMlN,YMlNfaCK6NUfXHl«XL0#YL0»XSIZ». 


Sfl 


8 

C 


60 


TR^ONM ♦ ER I^TP. ERPKE Y I ILE  t 
TF IL«  ST AE IL • ASAVf  AS^VFL 


:SENO 


YHt tYSIZ.MMlNSfSYHMTX (3?) .PM4TRX(60» .BVEC 1 30) •NflVCHN.NOEEAT 
-*  - 0AONtPNTADW.lDA0R.NC«HMF£ATtBM£0MP 

~F»0RMl0,0MMl0l.0RMCLRt0 

DPHCNT.UH»rT  1 .U*''’VtCfnRMVCJ  ■ — - 

,OPMPTR.0RMPTl.FETVEC(16) 

>N0SU6 


»SCALKY.HENADRtFL 
tNOVECtTOT.^NS«SI 
DRMCNT»DW“Cn  tOPMy 


data  blank/*  •/ 

L0R2  s ALOG10(2.0)  ■ 

MAXSIIH  « 1 

IF  (XYSCLF  .EO.  0)  60  TO  70 

DATA  IS  RESCALED  TO  lOl  BINS 

XSTZF  • X5I7 
YSTZE  « YSl? 

1F(XSI7F  .GT,  lop  XSIZE  ■ 101 
IFCYSlh’  .GT.  101)  YSIZE  « lOl 

RANGES  FOR  THL  X-AXIS 

nSIZ  » XSI7E  / 10  ♦ 1 . . 

XSCALE  * FlOAT(XLO-Xh!)/(XSIZE  - p 
X5MET  s float (XS17E»Xh1-XL0)/(XSIZE-1) 

''xAXl«;(ns}z-IM)  « (10«1-9)«XSCALE*XSHFT  ♦ .501 
rONTIMiE 

SCALFY  X FLOAT(1-YSIZE)7YH1-YLO 
ShETY  X -YwI**;CALFY  ♦ 1.0 
SCALE*  * FLOAT t 1-XSIZE)/XM1-XL0 
SHFTX  X -XmI«SCaLFX  ♦ 1.0 

RANGES  FOR  THE  Y-AXiS 

ISIZ  s YSI7E  / 10  ♦ 1 

YSEALE  X FLOAT (YL0-Y«I)/IYSIZE-1) 

YSHFT  X FLUAT(YS12E*YhI-YL0)/(VSIZE-1> 


no  60  Ixl,ISI7 
YAXI5(1S1Z-I*1)  X (10*  1- 
CONTINUE 
RETURN 

data  is  not  rescaled 


R)  •YSCALE  ♦ YSHFT  ♦ .501 


1 D • ORM i 0 1 • DRMCLR  t OHMCR 1 1 ORHTNS  * DRMTN 1 f 
rCl.VCCTRl.QATAl.NVEC.NOHEAD.LREAO 
,OHMPLT»CSCALE 


NOOOIO 

;nooo20 
N00050 

Inoooao 

mm 

Noono 
1N00120 
iNOOiSO 
1N00140 
N00150 
N00160 
N00170 
NOOISO 
NOOIRO 
N00200 
[NOOzIO 
N002 
N0( 

,N0( 

N0( 

InoI--- 

N00270 
NOOlSO 
[N00290 
IN00300 
[NOOSiO 
N003Z0 
[N00330 
N003A0 
N00350 
N00360 
N00370 
:NU03R0 
N00390 
[NOOAOO 
iNooAio 
:nooa2o 

N00A30 
N004A0 
NOOA50 
:noo460 
IN00470 
N004BO 
N00490 
NCOSOO 
NOOSIO 
N00S2O 
N00530 
1N00S40 
N00550 
N00560 
N00S70 
[NOOSBO 
biNOOSRO 
L1N00600 


h 


N00610 
IN00620 

iN00630 
N00640 
N006S0 
N00660 
IN00670 
.INOOGAO 
LIN00690 
LIN00700 
L1N00710 
LIN0P720 
LIN00730 
L IN0O7A0 
L1N007S0 
L1NC0760 
L1N00770 
L1N00780 
LIN00790 


^9^ 


FILE  I LINPLT 


7n 


T9 


BO 

90 

100 

110 

11*5 


1?1 

117 

1?0 


1?3 


O 


xoxlllt) 

RETURN 


LINOOBOO 


0) 


DS12 
YLO  ♦ 
XLO  * 


ENTRY  STOPTStCOlINTRtLlNEtSAHRLE) 

REAL  SAMPLEfLlNE 

COMPUTE  POSITION  ON  GRAPH  FOR  ISAMPLEtLlNCI 

TF  (XYSCLE  .EO.  1)  60  TO  110 
YPOINT  ■ YST2E  - (LINE  - YLO) 

XPOINT  ■ SAMPCE-XLO 

IF  (YPOINT  ,6T.  0)  GO  TO  «0 
YPT  ■ YPT  ♦ 1 
RETURN 

IF  (YPOINT  ,LE. 

YPT  « YPT  * 1 
MFTURN 

IF  (XPOINT  .GE. 

XPT  • XPT  ♦ 1 
PFTURN 

TE  (XPOINT  .LE. 

XPT  ■ XPT  ♦ 1 
RETURN 
CONTINUE 

YPOINT  ■ L1NE»SCALEY  ♦ SMFTY  * .501 
XPOINT  a XSIZE  - (SAMPL|*SCALEX  ♦ S 
IF  (XPOINT  .IT,  0)XP01NT  ■ 0 
IF  (XPOINT  ,0E.  X5IZE)  XPOINT  ■ XSXZE  - 1 
IF  (YPOINT  ,LT.  1)  YPOINT  ■ 1 
IF  (YPOINT  .GT,  YSIZE)  YPOINT  b-YSIZE 
XYXDR  * (YPOINT  - 1)*XSUE  * XPOINT  ♦ ORMPLT 


101)  60  TO  90 
0)  60.  TO  100 
100)  60  TO  115 


HFTX  ♦ .501)  ♦ 1 


LOG  X BOSE  2 OF  THE  FREQUENCY 


TF  ( LOG  .NE.  1 ) GO  TO  117 

.Ills 

. 1)  GC 

COUNT  s COUNTR 


CALL.RPEAO(XYADR.,SOM],|iISTATl) 


1?Z  IF  (ISTiTl  .EQ.  1)  GO 


122 


GUMl  3 SUM!  ♦ ALOGIO(COUNT)  / L062 
CALL  BRRITE (XYADN.SUHl.l,|STAT2) 

IF  (ISTaTZ  .EQ.  n GO  TO  121 
BUM  B BUMl  * 0.5 
GQ  TO  125 
CONTINUE 

CALL  RPE.AO(XYftnR.SUM.l.ISTATl) 

IF  (ISTaTI  .EO.  n 60  TO  120 

TOTAL  NO.  OF  OCCURPENCES  FOR  ALL  THE  DATA  VECTORS  ASSIGNED 

TO  This  (sample, line)  position 

BUM  B Bum  ♦ COUNTR 

CALL  RQPiTt (XYAOR.SUMf 1. ISTAT2) 

IF  (ISTAT2  .EO,  1)  60  TO  123 

bave  the  largest  no.  of  occurrences 


CONTINUE 

IF (SUM  .CT.  MAXSUM)  MAXSUM 
RETURN 


« SUM 


126 


entry  PRTPlT (PnTR.PNTRS) 
REAL  PNTRS(l) 

OIMENSION  «INS(16).PNTR(1) 


IF  (LOG  .NE.  1)  GO  TO 
call  RPEAD(nwMPLl  .p.nTm 
IF  (ISTAT3  .EO.  1)  GO  to 


«PNTR1 (101) 


129 

i. 10201, ISTAT3) 


N00610 

N00820 

N00H30 

N008A0 

N00850 

N00860 

Xtli 

N00890 

N00900 

N009r0 

N00920 

[N00930 

;noo9ao 

'N00950 

N00960 

,N00970 

N0Q980 

N00990 

NOIOOO 


LIN01220 

L1N01230 

LlNOiZAO 


126 


N01330 


L|NO 
NO 
NO 
NO 
.NOl 

l!noU3o 

‘ ‘NOl^^* 
NOl 

N0U60 
NO  ■ 
NO 
NO 

NOiSOO 


w A V 1 

L1N015A0 
.N01S50 
IN01560 
1N01S70 
L1N01580 


FILE I LINPLT 


IF  FREO.  LESS  THAN  ZERO*  SET  THE  FREO.  TO  1 

I? J2}J|!jr:fl:  !:81 88 18  If? 

ifT  RNTRS(l)  ♦ 0*S 


l»«  fONTINUE 
«0  TO  ill 
\9Q  rONTlNUf 


CfLL.RREAO(ORHPL1.PNJR|^0|01*ISTRT3) 


lin  IF  HSTAT3  ,EO. 
m CONTINUE 

SET  BIN  LEVELS 


n 


CALL  SETHRO(66«0*66> 
wPlTE(A.HEAn) 


ns 

uo 

ISO 


i 

c 


h 

c 


1«7 

zno 


wPITE«A»13f> 
format (//fs?.* 

IF  (NBTNS  .OT. 
PANfiE  « max SUM 


no 

no 

n3 

ns 

no 

ns 


Z?n 


»(M« 

Uo  I«1*NSINS 
^S(I)  ■ BAN6F*I 


L FREOUENCY 
WM)  nBINS  ■ 

*NE.  0)  RANGE 


SliliS' 


R PLOT*) 


IF  (MOOIMaxSUM.NSIN 

00  ■ ■ 

BIN . 

WRTTF(6*1S(I)  (BINSU)  «ni*NBINS) 
FORMAT(//17X«lHl*2X*i3«9(3X*lS)) 
NB  • NPINS  ♦ I 
MBS  ■ ?*NBINS 
no  J ‘ 


» RANGE  ♦ 1 


\U 

ns 


. . (6Vy6i)t(SVMMTX(J) ♦I»l*6) *J»1*NB1NS) 
MRTTF  (f  ,ni)  ( (SYHMTX(J)  *1b1*6)«JsNB«N8S) 


V»RT1 


jBl.YSIj 

j-inxs! 


F0PMATClH*.nx.96Al» 
CONTINUE 
F0PMAT(l7X*P#.Al» 
MPlTFCBtlSS)  . 
FOBMAT(//> 

00  200 
KK  « Tj 
KKK  ■ KK  ♦ YST 

no  no  !»i.xsi7 
II  « (j-n*xsnE 
tF  (PNTMill)  .NP. 
PNTPdl)  « BLANK 
PnTPI  (D  • BLANK 
00  TO  180 
BINLFv  * PNTP(in 
IF  (MOOCRNTOUlf . 


:i 

.*of  GO  TO  170 


PNTP(Il) 
PNTPI (!) 
CONTINUE 


SYHMTX ( 
SYMMTX( 


/ RANGE 
PANGE)  .NE< 


mi 


•V) 

[V«NB1NS) 


0)  BINLEV  B BINLEV  * 1 


PRINT  A LINE 
L B 11  - J/n 

IF  JMOniJ.n)  ,E0.  1)  60  TO  190 
wftTTF  n.  n3» 

FnOMAT(l6X*lH-) 

wPTTE(f«nS)  (PNTR(K)  ,KBKKiKKK) 
NRITF.  (6t  nS)  (PKTHi  (K>  .KbUIOI) 
F0PMAT(  1H*  *T17tl01Al) 

«0  TO  200 

WPITF<#>,nS)YAXlS(L) 

FOPM A T (1 0 X . 1 s » n • 1 M* ) 
WRITF<A,107)  (PNT**(K>  .KBKKtKKK) 
WMITF  (A.  nTMPNTRl  (K)  * Kb1«101> 
FOPMAT(lH*,T17*l0lAl) 

CONTINUE 

PRINT  X-AXIS  scales 


WPTTF(S.220» 
format  ( iH*»  nx« 


(XAxis(i>*iBi*nsiz> 

10(IH**9(1H-) )*1H*/1AX*11 (13«7X)1 


TOTPTS  a XPT  » YPT 
IF  (TOTPTS  .CO.  0)  RETURN 
ubitf (A.??S»  TOTPTS 


L 

L 

L 


N01590 


NO 


NO 

;:8 

;:8 


NO 


60( 


li 

6A( 


N0I6 

N 
N 
N 
N 
N 
N 

21 

21 
NO 

21. 

NO 1760 
NOJ770 
780 
790 
GOO 
0 
0 

ga8 
NOlBSS 


6AC 

69C 

ii 


660 


N0{G70 

21,- 

21 
NO 
NO 
NO 
NO,  . 

21‘^ 

21 


A9( 

900 

910 

920 

930 

940 


ill 

970 
9A0 
^9B6 
N020('0 
N020i0 
N02020 
N02030 
N02040 
N020SO 
N02060 
N02070 


NO, 

NO, 

no; 

no; 

no; 

no; 

NO, 

no; 


fill 

?l 


15( 


2:i|fi 

N02160 
N02190 
N02200 
N02210 
N02220 
N02230 


LIN022A0 


N022S0 
N0226A 
N02?7u 
N02280 
N02290 
N02300 
N02310 
N02320 
N02330 
N02340 
N023SO 
N02J60 
1N02370 


riUCl  LINW.T 


•»cctiON_oa 


Of 


cIlL  §eTMitO(6 
RETURN 
END 


TOTRL 

Hj*/*  inc 

sijfijr” 


. ^ ^ * ’l****  POINTS  WERE  NOT  OISRLAYEQ  ON  THf  kiNFL 

E«^ORaRh,.»/»_TME  points  were  out  Of  RANGE  IN  ElThER  THE  X ' 


OIL 
L 
L 
L 
L 


N023R0 
NO?3  ‘ 
N02A 

no|a|o 
N02430 


flL^I  M*TTNS 


SURPOUTINE  NATTNS(A«B«CfO«LtM) 

C multiply  a PY  B and  AOO  0^  STOPE  IN  C 

INTE6EP  B 
C 

niMENBION  A(L«H)*p(M)«C(L)«0(L) 

no  20  I«1»L 

SUM  ■ 0.0 

DO  10  K«l*M  ' 

10  SUM  • SUM  * A(I.K)  • B(K) 

20  C(T)  > SUM  « Dll) 

PETURN 

END 


oJi/GWAr,  Page  ,s 
»on  qvauty 


riLfi  orrsET 


SURROUT 1 NE  OFFSE  T < YSC ALE  * XSC ALE ) 


OFFOOOIO 


C 

C 


BA 


\m 

N/&l09AL/hEAO(63 
mISF 


YHNXLO 


iNCLunr 

NCLUDF 

OHMON/ 


OBUMAOtQAMWOS 

‘ i«N«3s“': 

. - r.DOTf IL.  . 

rwnUNTtMHTlINtfKAMOlO 


.Nrl^TUN 
•OOTUNT.DOtf 


D(63»»MAPTAP,OATAPEjSAVTAP.0HFlLE*BM5CYf 

lL»HISREY»TeFORH.EH|PTPtE«PK|Y*2APUNTtNOFILC* 

«VA64T2«t)ATML*STAFiL*ASAV«ASAVFL 


TFtiSCTRUN.MAMKiL 

■■  .NCHPAStTBNSFL.flMTRFLtHlSTFL«PCHUNTt 


r$ENO 


F (PHKEY  .EO.  0>  60  YO  AO 
F IRSC4LF  ,F0.  1)  SO  TO  PO 
F (CSCALE  .FQ.  n 60  TO  AO 


XMIGH  s XMAX 
XLOrf  ■ XWlN 
YMISH  * VMAX 
YLOW  « YAlN 
SO  TO  90 


XHlSH  ■ XHI 
XL'TW  « XLO 
VHISH  ■ YMl 
YLOrf  > YLO 


90  rO»<TlNUF 

XINC  B (XHISH  - XLOW) 
yInC  ■ (YHlSH  - YLOta) 
XSf  ALF.  (II  B XLO*/  • 
YSCALFJl)  B YLOiJ 


100 

no 


r*o  loo 


IbP.xsIZ 


XSrAUFdl  « *SCALF(I-1» 
lB?«YFl? 


no  no 

YSCALFd) 

oetupn 

FNn 


FLOATIXSIZ-ll 

FL0AT(YSIZ-i» 


XlNC 


B YSCALFd-1)  * YINC 


f0'>'M0N/SCTTFR/»»SCALC.»YSCLF«CLPVEC(3«)  »NCLPCH,CLPKEY.LOOt 
F»FC,x«AX.YHAX,XMlN,YMlN««CA6NO»XHl.XLOtYLOtXSIZ«,^ 
YMltYSIZ.NAINS«SYHMTX(3?l »BMATRX(6«»  »«V£C(30»  t NgVCHN,NOFEAT 

.SCAL*<Y,t'FNAI)N.FLnA0K»PNTAUP»l0A0P»NC.BNFEAT.«MC0H5 
.NOvEC»T0T»-NS.SIZEfDRM|0.DPMlfll,DRHCLR»0RHCHl.OPMTNS*0RMTNl* 
npMCNT.OPMCtl,OBBV£C*OkHVCl«VECTRi»nATAl»NVEC»NOP£AOtL»»£AO 
,0R-PTR,0«MPT 1 tFET VEC  < 16» ♦0RMPLT«CSCALE 
.NOSUH 

DIMENSION  YSCALE(YSIZ) «XSCALE(XSIZ) 

scales  are  COMPUTED  IN  ONf  OF  3 WAYS  « 

II  DATA  HAS  NOT  HEEN  FRANSFOHHEO 

HHKFY  ■ 0 

PI  DATA  HAS  BEEN  THANSFOKMED  and  rescaled 
31  OaTA*HAS*BEEN  TPANSFORMEOt  BUT  NOT  RESCALED 

C^CALk^B*/—  XSIZ  ANO/OP  YSIZ  HAS  BEEN  INPUT  - MIN  AND  MAX 
WILL  BE  USED  FOR  HI  AND  LO  PARAMETERS 


, fF6606( 

V4^A 

COMOOOlO 

iSKSISfS 

cohqcoao 

COMOOOSO 

COH00060 


OFF  00 


OFFQOlAO 

OFF00150 

OFF00160 

OFFOOIYO 

OFFOOIBO 

OFFOoioo 

OFF00200 

offooMo 

OFF00220 

OFF00230 

OFF002A0 

OFFO02SO 

OFF00260 

OFF00270 

OFF002M0 

OFF00290 

OFF00300 

OFF00310 

OFFooato 

0FF00330 

OFF003A0 

OFF003S0 

OFF00360 

OFF00370 

OFF003A0 

OFF00390 

OFFOOaOO 

OFFOOAIO 

OFF00A20 

OFF00A30 

OFFOOaaO 

OFF004S0 

OFF0O460 

OFF00B70 

OFF004A0 

OFF00A90 

OFFOOSOO 

OFFOOSIO 


3of 


nnnnnn 


FILE:  RESCLE 


C«ENO 

C 


SUBROUTINE  RESCLE IDATA.SKTCH.NVECT)  , 

* 

RESCLE  RESCALES  THE  TRANSFORMED  DATA  ^ „ 

SWTC-<  ■ 0 rescale  The  ENTIRE  ARRAY^  ^ 

SWTCH  a 1 RESCALE  ONE  PIXEL  AND  RETURN 

1NTF»?ER  8HCOMB. SWTCH 

INTEGER  <mI»XLO»YHI»YLO  _ ^ .... 

REAL  max  (2)  «HIn(2UREAL(2)  tRANGE(2)  •DATA(2«NVECT) 

INCLUnF  CMHKl?,LISf 

COHMON/SCTTPR/RSCALE»*YSCLE*CLPVEC<30) «NCLRCHtCLRKEY»LOG* 

» FREO.XMAX*YH£X«XHIN.YHIN.BCKGND*XHI*XLOfYLO«XSIZ* 

* YHl.YSlZ»NflINStSYMMTX(3?)  «8MATRX  (60)  .BVECOO)  »NBVCHN,N0FEAT 
» ,Sr.«LKY*HEN4DW«FL0ADH«PNTAl)R*I0A0H*NC*BRFEAT*BMC0MB 

» ,NOVEC.TOTMNS»SI7E.UHMlUtOHMI01.DRHCLH*DRMCRl»ORMTNStORMTNl* 

* nR>'CNT*t)HMCTl  *0HMVEC»DRHVCltVECT«l»DATAl»NVEC»NOREA0»LREAD 
» ,D»HPTfi.DRHPTl.FETVECIl6) »ORHPuT*CSCALE 

* » NOSUB 


HAXd) 

t4AX(?) 


XHAX  ‘ 
YMAX 


MINd)  s XMIN 
HIN<?)  a YHTN 
RAN6F(1)  s XHI  - XLO 
RaNPP(2)  = YHI  - YLO  ■ 

DO  200  J=1»NVECT 
00  100  I=1.PHC0MB 

»EAL(I)  = RANGEd)  / (MA!!(I)-MIN(I)  ) 

100  OATACI.J)  a R£AL(I)*A8S(HIN(1'  - DATA(IfJ)) 
IF  (SWTCH  .EO.  1)  RETURN 

200  CONTINUE 
RETURN 
END 


RES00020 

RES00030 


RESOOOAO 

RESOOOSO 

resooSgo 

RES00070 


RESOOOSO 

HES00090 

RESOOIOO 

RESOOllO 

RES00120 


RESOOIAO 

RES00150 

RESOOIOO 

RES00170 

PESOOiSO 

RES00190 

PES00200 

RES00210 

RES00220 

RES00230 

RES002AO 

HES00250 

PES00260 

RES00270 

HES00280 

RES00290 

RES00300 

RES00310 

RES00320 


Op 


" Ik 


FILF:  SC^TTR 


SURR0UTIN£  ?C«TTR(FIEL0$tVERTEX*TNSDAT»HEANStPL0TtPNTR*10ATA«T0P* 
• LIMIT. BUFF) 

SCATTR  SETS  UP  THE  LOGIC  FOR  CREATING  THE  SPECTRAL  PLOTS 
IMPLICIT  INTEGER  (A-Z) 

REAL  XSC ALE  » YSC ALE . XLOWER. XUPPER* YUPPER * TNSOAT  <2. 1 ) 

REAL  YLOWER. line. sample 
LOGICAL  SMiTCHfA) 

niMENSION  Bt'KF(l) 

OIMFNSION  XSCALEJ200) .YSCALE(200) 
nt“ENSION  IGG(4).IEN(4) 

OIMENSION  F?FLOS(A.l»  .VERTEXia.n.PLOTID.MFANsm 


*.PNTM ( 1) « 1D4TA (XSIZ.NC) 
OIMENSION  LINAORU)  .LIN 
DIMENSION  C0VAR(46S) 


INCLUDE  COmRkulIST 
INCLUDE  COMHK6.LIST 
INCLUDE  CMt^KlZ.LIST 

COMMON/ INFORM/NOCLS2.NOSUR2.NOFET2.VARSZ2.TOTVT2.NOFL02. 

AVAR?*C0VAR?.CLS102.SURN02*SUBDS2.FLDSV?*VERTX?. 
FtlVCZOO)  .SUHVC2(75)  .SUHPTP (75)  *CLSVC2(60)  . 
KEPPTS(60) .NOGRP.GHPNAM(60) .GRPOEXtGl). 

GRPrhK (61). GROUPS (124) 

COMMON/GLOBAL/HF.AO(63)  .maptap.datape.savtap.bmfile.bmkey.^ 

HISFIL.HISKEY.TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILF. 

nPKMftO.nRM^OS.PAGSIZ.DATFIL.STAFlL.ASAV.ASAVFL 

.NHSTUN.NMGTFI.SCTWUN.MAPFIL 

.nOTUM.nOTFIL.NCHPAS.TRNSFL.BMTRFL.HlSTFL.PCHUNT. 

CRDUNT.PpTONT.PANOIO 

COMMON/SCTTE«/RSCALE.XYSCLE.CLRVEC(30) .nclrch.clrkey.log* 
FRFO.XMAX.YMftX.XMIN.YHlN.BCKGNO.XHI.XLO.YLO.XSlZ* 
YHl.YSIZ.NfilNS.SYMMTX{3?).PMATRX(60) .HVEC(30) .NBVCHN, NOFEAT 
.SCALKY.KFNAOw.FLDAOH.PNTAOR.IOADW.NC.BMFEAT.BmCOMB 
.NOVEC.TOT*'NS.SI7F.O«MIO.ORMI01.0RMCLR.OHMCR1.DPMTNS.ORMTN1. 
DHmcnT.ORmCTI . ORMVEC.OMMVCl. VECTH1.DAT AI.NVEC.NOREAO.LREAD 
,ORmbtH,DRmPT 1 .FETVEC (16) .ORMPLT.CSCALE 
.NOSUB 

READ  REC  ? FORM  N-OIM  HIST  FILE 

READ(NHSTUN)CLSVC?(1) . (SURVC2(I) .Isl.NOSUB) . ( (FIELOS(I.J) » 

* I»1 .4) »Jal .N0FL02) . ( (VERTEX (l.J) .1=1.2) .J=1.T0TVT2> 

ARE  COLOR  COOES  COMING  FRON  STAT  FILE 


IF  (CLRKFY  .NE.  1) 
IF  (NOFEAT  .NE.  0) 


GO  TO  90 
GO  TO  80 


default  channels  are  channels  FROM  N-OIM  HIST  FILE 

no  60  I=1.N0FET2 
iO  FETVEC (I)  = FE7VC2(I) 

EXTRACT  JUST  MEANS  FROM  STAT  FILE 

RO  CALL  GETST (SAVTaP.STAFIL. MEANS. STDEV. NOSUB?. SUBVEC.NOFEAT. FETVEC. 
* mEANS.COVaR.O) 

WRITE  OUT  SAVED  training/test  FIELDS 

»0  CALL  WPTFLD(F1EL0S. VERTEX, N0FLD2. 2. CLSVC2.SUBVC2) 

READ  N-OlM  HIST  file  AND  STOWE  INFO  ON  ORU)< 

call  ST0FIL(LIMIT. means. BUFF) 

ORMVCl  = DRBVEC 
NVECT  = NVEC 

no  oj  ii=i,noreao 

IF  Ol  .EN.  NOWEaO)  NVECT  = LREAD 

NWOPDS  = NVErT*SI7E 

call  HPFA0(0RMVC1 .PLOT. NWOPDS. STAT) 

DRMVCl  = OW’VCl  ♦ NmORDS 
91  IF  (STAT  .KQ.  1)  GO  TO  91 

APPLY  transformation 


SCAOOOlO 

SCA00020 

SCA00030 

SCA00040 

SCA00050 

SCA00060 

SCA00070 

SCA00080 

SCA00090 


SCAOOlOO 

SCAOOilO 

SCA00120 


SCA00130 

SCA00140 

SCA00150 

SCA00160 

SCA00170 

SCA00180 

SCA00190 

SCA00200 

SCA00210 

SCA00220 

SCA00230 

SCA00240 

SCA00250 

SCA00260 

SCA00270 

SCA00280 

SCA00290 

SCA00300 

SCA00310 

SCA00320 

SCA00330 

SCA00340 

SCA00350 

SCA00360 

SCA00370 

SCA003B0 

SCA00390 

SCA00400 

SCA00410 

SCA00420 

SCA00430 

SCA00440 

SCA00450 

SCA00460 

SCA00470 

SCA004GO 

SCA00490 

SCA00500 

SCA00510 

SCA00520 

SCA00530 

SCA00540 

SCA00550 

SCA00S60 

SCA00570 

SCA005B0 

SCA00590 

SCA00600 

SCAOOblO 

SCA00620 

SCA00630 

SCA00640 

SCA00650 

SCA00660 

SCA00670 

SCA006B0 

SCA00690 

SCA00700 

SCA00710 

SCA00720 

SCA00730 

SCA00740 

SCA00750 

SCA00760 

SCA00770 

SCA00780 

SCA00790 


>5^ 

ao3 


r>oor> 


FlLEl  SCATTR 


IF  «BMKEY  .NE.  0)  CALL  TNSFER(PLOT»TNSOAT.NWECT»II>  * 
NO  TRANSFORMATION  APPLIED 

IF  (BMKEY  .EO,  0)  CALL  UNPCKV <PLOTiTNSOAT*NVECT) 

SORT  VECTORS  IN  OECENOING  ORDER 

CALL  S0RTVC(TNS0aT;pnT«*1C0L. NVECTtIBG.IEN.il> 

CALL%WHI?e'«ORMTN1.TNSDAT,ORMWO»ISTATI>. 

02  IF  (1ST ATI  .FO.  1)  OO  TO  92 

nRMTNla  ORMTNl  ♦ DPMWD  . , 

CALL  RwRITE(0RMPT1»PNTR»NVFCT.ISTAT2) 

IF  (ISTAT2  .EQ.  n 60  TO  94 
“ ^ NVECT 


94 

93 


0) 

2) 


GO 

60 


TO 

TO 


97 

97 

2 

TO 


95 


NREAO  = NREAO  «OMfiINAL 

OF  POOR 


quarh 


NTNSVC  = LSREAD 


C 

c 

€ 

c 


ORMPTl  * ORMPTl 
CONTI  N(»F 
IF  (R5CALE  .FO. 

IF  (SCALKY  .NE, 
nPMTNl  a ORMTNS 
NTNSVC  a (TOP  - VFCTRU  / 

IF  (NOVEC  .LT.  NINSVC)  GO 
NPCftO  = nOVFC/N'TNSVC 
IF  (mODINOVPC. NTNSVC)  .N£.  0) 

LSREaO  a (MOn (NOVEC .NTNSVC ) ) 

IF  (LSREAO  .EO.  0)  LSREAO  = NTNSVC 
GO  TO  9S 
9S  NPFAD  = 1 

NTNSVC  a NOVFC 
LSPFAD  a NTNSVC 
9P  00  99  I 1=1. NPFAD 
IF  (11  .EO.  NPFAO) 

ORMWO  a 2 * NTNSVC  . 

CALL  RREaO  (DRMTN) .TNSOAT.DRMWD  .1STAT2) 
im  IF  (ISTftT2  .PN.  1)  GO  TO  101 
CALL  RFSCLEdA'PDAT.O. NTNSVC) 

CALL  Rw9lTE(nPPTNl«TNSOAT.nRPWO.  .ISTAT3) 
100  IF  (ISTAT3  .FO.  1)  GO  TO  100 
nRMTNl  a 0R»'TN1  ♦ ORMWO 
99  CONTINUE 

COMPUTE  TAPE  CO/OPOINATES 
97  CONTINUE 

CALL  OFFSET (VSCALE.XSCALE) 


WRITE  tape  oAPAKETERS 

300  FORMATdfsi  1 .SCATTER^PLOT  TAPE  PARAMETERS  • »//T5l  t *N0.  OF  LINES 

* FTLF  a',l4/TSl.'N0.  OF  SAMPLES  PER  LINE  =**14) 

IF  (RMK’fv  ,EU.  0)  WHITE  (6.310)  XLO.YLO.XHI.YHI 

310  FORMAT (/TSl . »XLO  a • . I4 » T7 1 . • YLO  a • , I4/T51 . 'XMl  ai , I*.T71» • YHI 

*TF^tpMKEY  .NF.  0 .AND.  HSCALE  .EO.  1)  WRITF(6»31 0) XLO.YL()»XHI . 
IF  (CSCALE  .FO.  1 .AND,  HV^FY  .6T.  0)  WPI TE (6. 31 0) XLO» YLO.XHI . 
TF  (Rmkey  ,NF.  n)  WWITE(6.3?0)XMIN.YMIN»XMAX.YMAX 
320  FDPM4T (/TSO. 'XHIN  a • »F 1 0.5.170. • YMIN  ai .F10.5/T50. *XMAX  a*,F10 

• T70..YMAX  a '.Fin, 5) 

FOPMAT  a 1 

CH  a NC  ♦ 1 

■ no  110  1=1. CM 

110  CLPVEC(I)  = I 

120  CALL  WRThE0(CH«CLRVEC.XS12.F0RMAT.SCTRUN) 

LSTLIN  = 0 

IF  (LOG  .E(J.  1 .OP.  FREO  iEO.  1)  CALL  LINPLT 

no  125  1*1  .NOREAD 
125  SWITCH(I)  a .TRUE. 

CAI L RPFADCnpMPTH, PNTP. NOVFC. ISTAT3) 
i=Ysiz*i 


5CA00809 
SCA00810 
SCA00620 
SCA00830 
SCA00840 
SCA008S0 
SCA00860 
SCA00870 
SCA00880 
SCA00890 
SCA00900 
SCA00910 
SCA00920 
SCA00930 
SCA00940 
SCA00950 
SCA00960 
SCA00970 
SCA00980 
SCA00990 
SCAOIOOO 
SCAOlOlO 
SCA01020 
SCA01030 
SCA01040 
SCAOIOSO 
SCA01060 
SCA01070 
scAoioao 
SCA01090 
SCAOllOO 
SCAOillO 
SCA01120 
SCA01130 
SCA01140 
SCA01150 
SCA01160 
SCA01170 
SCA01180 
SCA01190 
SCA01200 
SCA01210 
SCA01220 
SCA01230 
SCA01240 
SCA01250 
SCA01260 
SCA01270 
SCA01280 
SCA01290 
SCA01300 
SCA01310 
PEPSCA01320 
SCA01330 
SCA01340 
SCA01350 
SCA01360 
SCA01370 
SCA01380 
SCA01390 
SCA01400 
SCA01410 
SCA01420 
SCA01430 
SCA01440 
SCA01450 
SCA01460 
SCA01470 
SCA01460 
SCA01490 
SCAOlbOO 
SCA01510 
SCA01520 
SCA01530 
SCA01540 
SCAOlbSO 
SCAOlbOO 
SCA01570 
SCA016HO 


at, 

YHI 

YHI 

.5. 


3c>y 


f»r»o  r»oo  o or»rin  nnnnnnnn 


FILES  SCATTR 


no  Ul-1 

|f  (f  .eO.  1 .AND.  CLRKEY.  .EQ.  3)  LSTLIN  « •! 

my  '=  XSCALfa).. 

YLOWER  ■ YSCALE(f-n 


r»o  140 
no  Uo 

140  T04tA<J«K) 


K«1,CH 
■ -12 
CK6N0 


J»1»K|1Z 


145 

146 


1465 


(ILINF  .NE.  1) 

. aiKE(ll)  .LE. 

CONTINUE 

TF  (LInE(II)  .LE.  YUPPER  .AND.  LINE(II)  .GT,  YLOWER)  GO  TO  147 
SwTTCHdl)  s .FALSE. 

TF  (ILINE  .NE.  YSIZ)  GO  TO  IflO 
IF  (LINEJIl)  .GT.  YUPPER)  GO  TO  147 
GO  TO  180 


position  point  in  X CO-ORDINATES 

147  SA’^ADw  = (^*^4V^C)*(II-l)  ♦ 2*1B  • ORMTNS  - 2 
CALL  RRE AO (SAMAOR. sample »1.ISTAT5) 

5WlTC»"(in  = .TRUE. 

14P  IF  (ISTM5  .PQ.  1)  60  TO  148 
00  ISO  Jsl.XSIZ 
IPOSTM  = J 

*LOwFR  = XSCALE(J)  ' 

XUPPEo  = XSrALE(J»l) 

IF  (J  .NE.  1)  GO  TO  149 
TF  (SAMPLE  .LE.  XLOwER)  GO  TO  160 

149  CONTINUE 

TF  (Sample  .6E.  XLOWEP  .and.  sample  .LT.  XUPPER)  60  TO  160 

150  CONTINUE 


160 


GET  COLOR  COOES 

CALL  CLPCOiX  IR. MEANS. lOATA. IPOSTN, II ) 
CALL  CUTER  ( IP. lOATA. IPOSTN. II .COUNTR) 
IF  (LOG  .EQ.  1 .OR.  FREO  .EQ.  1)  CALL 


STOPTS (COUNTR. LINE (II). 
SAMPLE) 


180 


CHECK  NEXT  VECTOR 

TF(IR  .EQ.  TFN(II))  GO  TO  180 
IF  (SWITCH(ITI)  IP  = PNTR(r 
IF  (SwlTCH(ID)  IHG(II) 
IF(Sk«ITCH(II)  ) GO  TO  145 

CONTINUE 

WRITE  A LINE 


' w * r? 

rR( jH*K) 


CALL 


200  IF( 

I.GT.l) 

GO 

TF 

(CLRKEY 

.FO 

TF 

(CLRNF.Y 

.EQ 

IF 

(CLRKEY 

.EQ 

IF 

(LOG  .EQ 

. 1 

'VRTLNnOATA. LSTLIN) 
- TO  130 


, 1>  CALL  CLRKYS(XSIZ.inATA. NOSUP?. CM. MEANS. NO 
, ?)  CALL  CLHKYS(XS1Z. IOATA.NOSUHP.CM.mEANS.no 
, 4)  CALL  CLHKYS(XSIZ. IOATA.NOFLD?. CM. MEANS. NC) 

.OR.  EREU  .EO.  1)  CALL  PRTPLT (PUFF.BUFF) 


SCA01590 

SCA01600 

SCA01610 


143  IF  (TSTAT3  .PQ.  1)  60  TO  143 

COLLECT  all  PDINTS  THAT  BELONG  TO  THIS  LINE (I) 

THF  DATA  VECTORS  WERE  READ  IN  NVEC  AT  A TIME.  EACH  BLOCK  OF  DATA 
VECTORS  HAS  ITS  OWN  POINTER  ARRAY  FOR  SORTING  THE  DATA  VECTORS  IN 
r>ESCEN01N6  OPOER.  EACH  POINTER  ARRAY  PNTR ( 1 . . .NOR£AO)  MUST  BE 
SEARCHED  FOR  POINTS  BELONGING  TO  LlNE(l) 

no  180  IIsl.NOREAO 
K = (n-l)4MVEC 
TB  = IPG(II) 

IF  (SWTTCM(ID)  LINaOR(II)  = (?*NVEC)*(  II-l ) ♦ 2*IB  ♦ ORMTNS  - 1 
IF  (SWTTCH(TD)  call  RREAD(LINADH  ( 1 1 ) .LINE  ( 1 1 ) . 1 . ISTA4) 

IF  (IST44  .PQ.  1)  60  TO  146 
IF  (ILINE  .NE.  1)  GO  TO  1465 
IF  (LINE (11)  .LE.  YUPPER)  GO  TO  147 


SCA01620 

SCA01630 

SCA01640 

SCA01650 

SCA01660 

SCA01670 

SCA01680 

SCA01690 

SCA01700 

SCA01710 

SCA01720 

SCA01730 

SCA01740 

SCA01750 

SCA01760 

SCA01770 

SCA01780 

SCA01790 

SCAOieOO 

scAOieio 

SCA01B20 

SCAOlbBO 

SCA01840 

SCA01B50 

SCA01660 

SCA01870 

SCA01880 

SCA01B90 

SCA01900 

SCA0I910 

SCA01S20 

5CA01930 

SCA01940 

SCA01950 

SCA01960 

SCA01970 

SCA01980 

SCA01990 

SCA02000 

SCA02010 

SCA02020 

SCA02030 

SCA02040 

5CA02050 

SCA02060 

SCA02070 

SCA02080 

SCA02090 

SCA02100 

SCA02110 

SCA02120 

SCA02130 

SCA02140 

SCA02150 

SCA02160 

5CAC2170 

SCA02180 

SCA02190 

SCA02200 

SCA02210 

SCA02220 

SCA02230 

SCA02240 

SCA0225O 

SCA02260 

SCA02270 

SCA02280 

SCA02290 

SCA02300 

SCA02310 

SCA02320 

SCA02330 

SCA02340 

SCA023S0 

SrA0?360 

SCA02370 


riLfj  scattr 

400  RETURN 
ENO 


ORIGINAL  PAGE  !S 
OF  POOR  QUALITY 


.>6^5 


FlL»fs  SETAOR 


C* 

C* 

r* 

c* 

c» 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 


c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

r* 

c* 


c* 

r* 

e: 

c* 

c* 

r« 

c* 


SUBROUTINE  SETftnB(*»*»TOP*BUFF»LlMIT) 


sftadr  co«^piites  the  address  for  storing  the  NOIM 
ANO  ADDRESS  FOR  THE  TwO  ARRAYS  - BUFF (LIMIT)  AND 


FILE  ON  DRUM 
array (TOP) 


1M»LICIT  INTEGER  (A-Z) 


COHRKi.LlST 
COMOKft.LIST 


INCLUDE 
INCLUDE  _ 

TNCLUOF  CMR<12,LIST 

C0MM0N/INF0RM/NbcLS2tN0SUR?.N0FET2tVARSZ?*T0TVT2»N0FLO2» 

^ AVAR?,C0VAR2.CLSI02.SURN02.SURDS2.FL0SV2.VERTX2, 

FETVC2(30) .SUHVC2(75) »SUBPTR (75) .CLSVC2 (60) ♦ 
KFPPTS(60) ♦NOGRP»6RPNAM(60) «6RPDEX(6l) » 

GHPCMK (61) .GROUPS (124)  . _ 

COMMON/GLOBAL/HEAD (63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY, 

HISFIL.HISKEY.TPFOHm.EHIPTP.ERPKEY.MaPUNT .nofile. 
DPUMA0.nRH‘.0S.PA6SIZ.PATFIL.STAFIL.  ASAV.ASAVFL 
.NMSTUN.NWSTFI .sctrun.mapfil 

•DOTUNT.OOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCMUNT. 

rROUNT.PRTUNT.HANOIO 

COHMON/SCTTFR/RSCALE.XYSCLE.CLRVECOO)  .nclpcm.clrkey.log. 
FRF0»XHAX.Y''AX.XMIN. YMlN.bCK6N0.XHl.XL0.YL0.XSIZ._  ^ 

YHI  .YSIZ.NBInS.SYMMTXO?)  .BMATkX(60)  .BVECOO)  .nbvchn. nofeat 
.scalky»«enaor.floaor.pntadr. ioaor.nc.bmfeat.bmcomb 

.NnvEclTOTMKsIsiZE.OHMIO.ORMlDl.DRMCLR.ORMCRl.ORMTNS.gRMTNl. 
DR'^CNT.OR'^CTI  .ORhVEC. ORmvC  1.VECTR1.DAT a I.NVEC.NOREAD.LREAD 
,DPMPTR.DR'-PT1.FETVEC(16)  .drmrlt.cscale 

SCTTER^'lS  A COMMON  BLOO^  LOADED  ONLY  WITH  THE  SCATTER  PLOT 

PROCESSOR 


PSCALE 

XYSCLE 


IS 


CLRVFC 

K'CLRCH 

CLRKEY 


LOG 


1 

? 

3 

4 


'TO  BE  OUTPUT  ON 


FRFQ 


XMAX 

YMAX 

XMIN 

YMIN 

RC^GNO  - 

XHI 

XLU 

YHI 

YLO 

XSTZ 

rONTINUF 

YSTZ 

NRTN'i  - 
c;ymmTx  - 
RMATRX  - 
RV^C 

NPVCHN  - 

nofeat  - 

SCALKY  - 


KEY  INDICATING  THAT  THE  TPANSFOPMED  DATA  IS, TO  BE 
KEY  indicating  that  THE  PIXEL  FREQUENCY  PLOT  DATA 
TO  OF  rescaled  TO  A RANGE  OF  100 
ARRAY  CONTAINING  THE  COLOR  CHANNELS 

KEY  INDICATING^ThE^MANNER  that  the  COLORS  ARE  BEING 

defined  . JMPUT  PY  PILE 

USER  INPUT 

radiance  VALUES  FROM  IMAGE  TAPE-  ON  NDIM 
FIELD  MEANS  - ON  NOIM  FILE 
KEY  Indicating  log(2)  of  frequency  is 

KEY^INo1ca^1N6''FREOUENCY  is  TO  BE  OUTPUT  ON  LINE  PRINT- 
ER PLOT 

---  COMPONENT 

component 
component 

COMPONENT 
background 
SCAN  line  parameter 
scan  line  parameter 

LINE  NO.  parameter 
LINE  NO.  parameter 
PER  SCAN  LINE 


SETOOOlO 
SET00020 
SET00030 
SET00040 
SETOOOSO 
SET00060 
SET00070 
SETOOOSO 
SET00090 
SETOOlOO 
SETOOllO 
SET00120 
SETOOiSO 
SET00140 
SET00150 
SET00160 
SET00170 
SET00180 
SET00190 
SET00200 
SET00210 
SET00220 
SET00230 
SET00240 
SET00250 
SET00260 
SET00270 
SET002B0 
SET00290 
SET00300 
SET00310 
SET00320 
SET00330 
SET00340 
RESCALESET00350 


MAXIMUM 
MAXIMUM 
MINIMUM 
MINIMUM 
COLOR  ' 
UR  PER 
L0‘-'FR 
UPPFR 
LO  vFR 
NO.  OF 


VALUE 
value 

VALUE 
VALUE 
FOR  TAPE 
LIMIT  OF 
LIMIT  OF 
LIMIT  OF 
LIMIT  OF 
samples 


OF 

OF 

OF 

OF 


1ST 

PNO 

1ST 

2ND 


OF 

OF 

OF 

OF 


TRANS. 

TRANS. 

TRANS. 

TRANS. 


DATA 

DATA 

DATA 

data 


MFNAOH 

FLOADW 

idadr 

PC 

RMFFA T 
RMfOMB 
NOVFC 
TOTMNS 


NO.  OF  LINES  TO  OUTPUT  ON  TAPE^^  ^ 

NO.  OF  ‘'IN  LFVFLS  OR  SYMBOLS  FOR  PIXEL  FPEO.,PLOT 

A»<oaY  CONTAINING  SYMBOLS  FOR  PIXEL  FRE(J.  PLOT 

ARRAY  CONTAlNIN(j  B-RATRIX 

ARRAY  C0NTAINIi>i6  AUDITIVE  VECTOR 

NO.  OP  AnoiTIVt  VPCTOR  LLEMENTS 

NOFpT?  ♦ NCLRCh  . 

key' INDICAING  the  manner  OF  COLECtiNG  THE  MIN  ANO 

VALUES  : 

= I - USER  INPUT  , ^ 

X }>  - COMPUTE  from  NDIM  file 
AOORFSS  FOR  storing  MEANS 

ADORESS  FOR  storing  FIFLO  INFO 

AOnWESS  FOR  STOWING  lOS  , , 

NO.  OF  ChanmFLS  FOR  COLORS  TO  BE  OUTPUT  ON  TAPE 

■"  CHANNELS  IN  B-MATRlX 
ITNKAC  COMB, 

vpctohs  on  moim  file 

Mt-AN  FLtMFNTS 


MAX 


NO. 

NO. 

NO. 

NO. 


OP 

OP 

('F 

OF 


SET00360 
SFT00370 
S6T003B0 
SET00390 
SET00400 
SET00410 
SET00420 
SET00*.30 
F1LESET00440 
SET00450 
SET00460 
SET00470 
SET004B0 
SET00490 
SET00500 
SET00610 
SET00520 
SET00530 
SET00540 
SET00550 
SET00660 
SET00570 
SET005P0 
SETOOSRO 
SET00600 
SET00610 
SFT00620 
SET0063C 
SET00640 
SETOObSO 
SET00660 
SET00670 
SET006B0 
SE  T00690 
SFT00700 

stmoTio 
SET007P0 
SET00730 
SET0()740 
SET007S0 
SETC0760 
SET00770 
SET007B0 
SET  00790 


•■;4 


F 


PILE*  SETAOR 


?: 

S: 

c* 

c* 

f* 

c* 

c* 

c* 

c* 

c* 

e: 

c* 

c« 

'♦ 


«iT7E 

DRMTD  - 
HRMIOI  - 
nRMCUR  - 
ORMCRl  - 
ORMTNS  - 
CONTINUE 
PRMTNI  - 
DRMCNT  - 
ORMCTl  - 
ORMVFC  - 
ORMVCl  - 
VECTPl  - 
DATAl  - 

NVFC 

N0RE4D  - 
LRFAO  - 

hrmptr  - 


NO.  or  «*OROS  FOR  PACKED  HISTOGRAMMFO  VECTOR. 
reginning  oxijh  aodmess  for  storing  IQS 

SU'^NING  . DRUM  AQORESS  FOR  PflPlV.  IDS 

REGINNInG  URUH  ADDRESS  FOR  STORING  COLORS 

SUMMING  DRUM  address  FOR  RETRlV.  COLORS 

BCGINNIN  DRUM  AOORESS  FOR  STORING  TRANS*  DATA 


summing  drum  ADDRESS 

beginning  drum  address 

SU“BING  DRUM  address 

beginning 'DRUM  ADDRESS 
summing  drum  ADDRESS 

ADDRESS  IN  • ARRAY*  FOR 
SA*‘E  address  as  VECTRl 
OF  DATA  OUTPUT  TO  THE 


FOR 

FOR 

FOR 

FOR 

FOR 


sfoRlNS 

RFTRIV. 

STORING 

retriv. 


DATA 


TRANS. 

FPEO, 

FRED. 

VECTORS 
_ , . VECTORS 

STORING  TRANSF.  VECTOR 

- USED  for  creating  a scan  line 

SCATTER  PLOT  TAPE 


NO.  OF  VECTORS  TO  READ  FROM  DRUM  AT  ONE  TIME 
NO.  OF  HEARS  TO  DRUM 

NO.  OF  VECTOR  TO  READ  ON  LAST  DRUM  READ 
beginning  DRUM  ADDRESS  FOR  STORING  POINTERS 

- - ---  'HANNELS 


C*  FETVFC  - ARRAY  FOR  CONTAINING  FETVC?  AND  CLRVEC  CHANNEL 
€•  ORMPLT  - beginning  address  FOR  STORING  FREO.  PLOT  IMAGE 
C**  CSCALE  - KEY  INDICATING  THAT  XSI2  OR  YSIZ  PARAMETERS  HA 


C** 

C* 

C* 

CSENO 

C 


Input 


DIMENSION  BHFF(l) 

oEAD(NhsTUN.END=150)  NOFLD?. NOSUB* T0TVT2*N0VEC 
IF  (CLRKEY  .ED.  1)  GO  TO  100 

IF  (CLRkFy  .FD.  2)  GO  TO  100 

IF  (CLRkEY  .FO.  3)  60  TO  120 

IF  (CLRkEY  .EG.  4)  GO  TO  130 


HAVE  BEEN 


100 


1?0 


no 


mENADR  = 1 

FLDAOR  = MENADP  ♦ 60*NC 
VERTX2  = FLOAOR  ♦ 4*N0FL02 
DATAI  s FLOAOR 
GO  TO  133 


C 

C 

C 

C 


fegaor  = 1 
VERTX2  r FLGaor  ♦ 
OATAl  = FLOADR 
GO  TO  133 

MENADR  s 1 
FLOADR  = MENADR  ♦ 
VERTX2  = FLD4DR  ♦ 
DATAI  = FLOAOR 


oRiGmi  PAcp ,, 
OP  Pooii 


N0FL02«4 


TOTMNS 

4*N0FL02 


133 


13S 


COMPUTF  MAXIMUM  NO.  OF  VECTORS  ARRAY  MAY  HOLD  AT  ONE  TIME 

VECTRl  = DATAI 

NVFC  = (TOR  - data!)  / 2 

VECTR?  s LIMIT  / SIZE 

IF  (VFCTH?  .LT,  NVFC)  NVEC  » VECTR2 

IF  (NOVf^C  .LT.  NVPC)  GO  TO  135 

NOREAD  = NOVFC  / nVEC 

IF  (MOD (NOVFC. NVEC)  .NE.  0)  NOREAD  « NOREAD  ♦ 1 
LPFAD  = MOU (NOvEC.NVEC) 

IF  (LRFAO  .F(J.  0)  LREAD  a NVEC 

GO  TO  140 

NOREAD  = 1 

NVFC  = NOVFC 

LREAD  = NVFC 

addresses  for  high  speed  drum 


. 140  DRMVEC  a OHMMAO 

OPMIO  = Dxfn/FC  ♦ NOVEC«SI2E 
DRMCNT  = ORMin  ♦ MOVEC 
IF  (CLRKFY  .EN.  3)  OHMCLR 


IF  (CLR*'E>  .Nf, 
dpmtn'S  s nM*.rLH 

PRMPTR  s DHI'TNS 
DRMPI  T = DRMotp 
TOTORM  = fiHMPLT 


3)  ORNCLR 

♦ tjOVFC 

♦ N0VF‘C«2 

♦ NOVFC 


DRMCNT 

OhmCNT 


NOVEC 


SET00800 
SETOOBIO 
SET00B20 
SFTOOfiaO 
SETQ0B40 
SET00B50 
SETO0B6O 
SET00670 
SET008BO 
SET00890 
SET00900 
SET00910 
SFT00920 
SET00930 
SE10Q940 
SET00950 
SET00960 
SET00970 
SET00980 
SFT00990 
SF.T01000 
SETOlOlO 
SET0I020 
SET01030 
SET01040 
SET01050 
SET01060 
SET01070 
■^TOlOBO 
:T01090 
iTonoo 
■TOUIO 
SET01120 
SET01130 
SET01140 
5ET01150 
SET01160 
SET01170 
SET01180 
SET01190 
SET01200 
SET01210 
5ET01220 
SET01230 
SET01240 
SET01250 
5ET012f>0 
SFT01270 
SET01290 
SET01290 
SET01300 
SET01310 
SET01320 
SET01330 
SET01340 
SET01350 
SET01360 
SET01370 
SET013B0 
SET01390 
SET01400 
SFT01410 
SFT01420 
SET01430 
SET01440 
SFT01450 
SFT01460 
St  T0U70 
SF.T014M0 
SFT01490 
SFT01500 
SET01510 
SET01S20 
SET01530 
SETO1S40 
StTOlSSO 
St  TOISNO 
St T01570 
St.TOlSfiO 


OUCJ 


riLFs  SETAOR 


TF  (LOfi  .F(l,  1 .OR.  FREQ  .FO.  1)  TOTORM  ■ DRMRLT  # 10201 
TF  ( ITOTDR**-DRUHa0»  .LE.  DRMWOS)  60  TO  143 
WRTTE(A.1*2»T0T0»<H«0RMi<DS  • 

14?  FOOH4T(/»  not  FNOUGH  drum  SP#CE.»/*  TOT4L  WORDS  OF  DRUM  SPACE  ■*» 
• 112/*  total  WORDS  OF  DRUM  SPACE  AVAILABLE  »*»I12) 

CALL  CHERR 
143  CONTINUE 

DRMVCl  « ORMVEC 
ORMIOl  « ORHIO 
ORMCRl  » DRMCLR 
ORMCTl  ■ ORMCNT 
ORMTNl  a DRMTWS 
ORMOTl  ■ ORMPTR 

ZERO  OUT  AREA  OF  DRUM 

IF  (LOG  .EQ.  0 .AND.  FREQ  .EO.  0)  60  TO  145 

no  147  1*1.10201 

147  PUFF(I)  = 0 

CALL  RwRTTE (DRMPLT. BUFF. 10201. ISTAT) 

146  IF  (ISTaT  .EO.  1)  GO  TO  146 
145  RETURN  1 • 

ISO  OEWINO  NHSTUN 

return  2 

END  . ■ ' 


SET01590 

SET01600 


SETO 

SETO 


}GI 

162 


SET01630 

SET01640 

SET016S0 

SET01660 

SET01670 

SET016B0 

SET01690 


SET01730 
SET 01 760 
SET01750 
SET01760 
SET01770 
SET01780 
SET01790 
SETOIBOO 
SET01810 
SET01620 


•TO  830 
[T01840 


FILFI  SETH 


SURHOUTINE  SETll (MEANS*HENS»BUFP) 
i<EAL^SMlTlixIIOIc«.M|N|<l)  *YMAXtXMAX«XMINfNUMtYMIN 


NSrON  HMFFO  I «SYMTX(32> 

C'HtCQMO)  tCOOE  (1A>  t CAPO (62)  tMEANSd) 

HMVEC(16) *ACAMO(20) 


■NSION 
> NS  I ON 


PATA  NPUT/IH/ 

DATA  FOUCl)M/?»  •■!♦•*•/ 

data  cope/ »CHAN t.»STAT*.»MlSF I •»PIXP»t 'COUP** 'SIZE** 

• tSYPB*  ♦ *»40nu»  ♦ 'DATE*  • •COM«'i  t •HEOI  • * *HE02*  t •PLOT* # 

• 'B-HAt.'bCKG'f •BVEC*»*SCAL».'*£NO*/ 

DATA  SYMTX/».».»/*. •C*»*0»»*0».«0»t»U**»U«**0*f 

• t *C •» 'O' 


• (•  I, 


t.i  ii 


•/ 


• * * * ' 

DATA  BLANK/*  •/.  XBCD/»X»/.  YBCO/'Y*/*  LBCO/»L»/i 
U HBCn/'M*/*  KOMMA/»f»/t  BRCD/'N'/t  YPCD/»)M/f 
• FBCO/»F«/tCBCD/*C*/.Ht)CD/*R*/.UbCD  '»U*/flBCO/»I*/»ABCO/«A»/ 


S SBCD/'S»/. 


INCLUOF 

INCLUDE 

TNCLUDF 

INCLUDE 


CMRK12.LH 


COMOki.lIL 
C0MBK6,L1ST 


COMHKA.LIST 

COMMON/ INFOPN/NOCLS2«NOSUB2tNOFET2*VAP§Z2,TOTVT2.NOFL02*_ 

* AVAP?tC0VAR2«CLSI02«SURN0|«SURDS2*FLDSV2*VERTX2* 

* FETVC2(30) .SUBVC2(7S) »SU8PTH(7S> •CL$VC2(60) * 
KEHPTS(60) *N06PPt6HPNAM(60) t6RP0EX(61) f 


ni 


MENS  I 
UIVAL 


GPPCHK ( 6 1 ) f groups (12*) 

" ■(15)»0ATE(3)«--  _ 

AO(*)>t(OATE(l|«HFAO 


ON  HEDl (15) ♦HEP2( 


equivalence  (HfOKD.H^  

2 


♦8^) 

►il5FlLiMlSKEY»TBF0RM,Ee!PTP«EBPKEY.MA^ 

nPUMA0*ni^i1kDS*PAGSIZ»nATFlL*SfAFILf  ASAVtASAVFL 


C0MM0N/6L0BAL/HEAD(63> .MAPTAP« 


COMENTCIS). 

_ 1).HFAD(22)). 

OMENT(l) ,HEa6(*81 
APE ♦ SAVT  AP. BMF ILEiBMKEY* 

IPTP.EBPKEY.MAPUNTfNOFlLE* 


CSEND 
C 


C 

C* 


CSCALE  « 
default 


VALUES 


10 


initialize,  parameters 
no  10  1=1.32 

SYMMTx(I)s5YMTX(I) 

FREQ  « 0 
LOG  = 0 
NOFFAT  = 0 
NCI-STR  * 0 
NpTNS  = 10 
RMKEY  a 0 
nCFGNO  * 25S 
XST7  a 101 
YSTZ  = 101 
RSCALE  a 0 

xysci.E  = 0 

VLO  = 0 
^CALKV  = 2 
YHl  » 100 
XHT  s loo 
XLO  a 0 
WRTTF  (A.mO) 

mo  format(//«  input  summary*//) 

SFTUP  REREAD  BUFFER 


SETOOOl 


iETOOORO 

SETOOIOO 

SETOoilO 

SET00120 

5ET00130 

SETOOIAO 

Ifmiii 

!too| 


.NHSTUN.NHSTFI .SCTRUN.MaPFIL 
.DOTUNT,OOTFIL.NCHPAS.TPNSFL»8MTRFL*HISTFLfPCMUNT* 
fwnUNT.PRTUNT.RANOIO 

COmmON/SCTTFR/RSCALE*XYSCLE.CLRVEC(30) ♦NCLRCH.CLRKEY*L06t 
FREO.XMAX.YMAX.XMlN.YMlN.BCKGNOf XHI *XLOfYLO»XSlZ» 

YHI .YSIZ.NHINS.SYMMTX (3?) .PMATRX (60) .RVEC (30) .NRVCHN. NOFEAT 
.GCALKr.MFNADR.FLOADR.PNTADR.IDAOR.NC.BMFEAT.BMCOMB 
.NOVEC»TOTt‘NS.SI7E.OWMlD.ORMIQl.DRMCLH.DRMCRl.DRMTNS»DRMTNl» 
ORMCNT.DRMCT 1 .URMvEC.ORmvCI ♦ VECTH 1 .OATAl .NVEC »NOREAOtLREAO 
,nRMDTR,DRMPTl.FETVEC(l6) .OHMPLT. CSCALE 
.NOSUB 


■too< 

s^l88< 

SET002A0 

SETOO|SO 

SET00|60 

|l?88h8 

SET00290 

SET00300 

SET00310 

SFT00320 

SET00330 

SET003A0 

SET00350 

SET00360 

SET00370 

SET00380 

SET00390 

SETOOaOO 

SET00410 

SET00420 

SFT00*30 

SET00440 

SET00450 

SET00460 

SET00470 

SET00480 

SET00490 

SET00500 

SET00510 

SET00S20 

5F.T00530 

SET00540 

SET00550 

SET00560 

SET00S70 

SFTOOSBO 

SFT00590 

SETOObOO 

SETOObiO 

SET00b20 

SET00b30 

SET00b40 

SET00650 

SETOObbO 

SET00670 

SfTOObHO 

SETOObQO 

SET00700 

SET00710 

SET00720 

SET00730 

SET00740 

SET00750 

SFT007IS0 

SFT00770 

SET007M0 

SET00790 


-i/o 


nr%  y rmr> 


riLFj  scni 


c 

c 


RrRCAO(30*N0) 


w R|*n  c**»n  iHTo  RurreR 
RFAO(?1.10A) (ACAhOTI) 
format??6a4) 


N0W*H^ 

Ki  : : 

WRITE 00«10A) (ACARO(I) *Ib1«20) 

REwlNn  30 

RfAnno.llOCOOEltCARO 
no  rOOMAT<A4,6X*62Ai) 

REWIND  30 
COL  • 0 

^ . . 
WRTTF(A,120)COnEliCARO 
ISO  FORMAT (IX. A4tAX*62Al) 

DO  130  I*1.NPUT 

IF  (CODEl  .EO.  COOE(I))  <30  TO  (150. 180.210. 250. 290*300«3A0i 
• 3S0. 370. 3R0. 460. 410*415*420. 455.460. 470. 477) *1 

130  CONTINUE 

wRTTF(4,140) 

140  P0RMAT(  • INVALID  CONTROL  CARO  — IGNORED*) 
fiO  TO  105 


150 

1S3 

155 

140 


1«0 


155 

157 

IQO 


200 


210 


2?0 

225 

230 


24  0 


CHANNEL  CARD  — NEEDED  ONLY  IF  STATS  FILE  IS  INPUT 

MaNXTCHRCCARO.COLI 

IF  (M  ,NE.  PLANK)  GO  TO  160 

WPTTF(6.155) 

format ( • ERROR  ON  CHANNELS  CARO*) 

50  TO  105 
COL  = COL  - 1 

NOFEAT  = NUMBER (CARO. COL. FETVEC.NOFEAT) 

CALL  ORDER (FETVEC.NOFEAT) 

NC  » NOFEAT 
CLBKFY  3 1 
50  TO  105 

STAT  FILE  CARD 

M 3 NXTCHR (CARO. COL) 

IF  (M  ,E0,  BLANK)  60  TO  105 
IF  (M  ,E0.  UaCO)  60  TO  190 
IF  (M  .EO.  FhCO)  GO  TO  200 

WRTTF(6.1P7)  j 

FORMAT (•  ERROR  ON  STAT  FILE  CARO') 

50  TO  105 

J 3 FIN012(CARO.COL.EOUCOM) 

IF  (J  .NF.  2)  GO  T01P5 
M X NIJMBER(CAR0. COL. SAVTAP. ZERO) 

COL  X COL  - 1 
CLPKFY  X 1 
50  TO  lAO 

J X FIM01?(CAR0.C0L.EQUC0M) 

IF  ( J .NF.  2 ) 60  TO  1H5 
M 3 NUMPER(CARO, COL. STAFIL. ZERO) 

COL  = COL  - 1 
60  TO  IBO 

N-niM  HIST05RAM  FILE 

M s NXTCHR (CAPO. COL) 

TF  (M  .F.3.  PLANK)  GO  TO  105 
IF  (M  .FO.  (IPCO)  GO  TO  230 
IF  (M  .EO.  FBCD)  GO  TO  240 
WRITE (6.225) 

format (•  ERROR  ON  N-OIM  HISTOGRAM  FILE  CARO*) 

GO  TO  105 

J 3 FIM)12(rABO.COL.EOUCOM) 

TF  (J  .NF.  ?)  GO  TO  220 
M s NUMm£R(CaRD. COL. NmSTUN, ZERO) 

COL  X COL  - I 
50  TO  210 

J X FIn['1?(CaRO.COL.EOUCOM) 

IF  (J  .^e.  2)  GO  TO  220 
M X NUMBER(CARC), COL. NmSTFI. ZERO) 

COL  X COL  - 1 
50  TO  210 

PIXEL  FPFQ.  PLOT  CARO 


;:]ii 

.'Tooesi 

’T0086C 

■T00870 

■T00680 

T00690 


'T00930 
rT00940 
■T00950 
^T00960 
■T00970 
:T00980 
•T00990 

sEToiooo 

SETOlOlO 

SET01020 

SET0103Q 

SETOIQAO 

SET01050 

SET01060 

SET0I070 

SET01060 

SET01090 

mim 

SEToilZO 
SETOfilO 
S^TOllAO 


.170 

1190 

?00 

>10 


J18 

S|T0 
SETO 
SETO 
SETOi 
SET01220 
SET01230 
SET0i240 
SET01250 
SET01260 
StT01270 
SET01280 
SET01290 
SET01300 
SET01310 
SET01320 
SET01330 
5ET01340 
SET01350 
SET01360 
SET0I370 
SFT01380 
SETOJ3RO 
SET01400 
SET01410 
SET01420 
SET01430 
SET01440 
SET0I450 
SET01460 
SET01470 

setoIaso 

SI  T01490 
StTOlbOO 
SET01510 
SET01520 
SET01530 
SET01540 
SET01550 
SET01560 
SFT01570 
SET01580 


riuf:  SETU 


M ■ NXTCMR(CA»0«C0U 
ir  (H  .PO.  RLANK)  56  TO  lOS 
CH  .Eo,  Lpro)  60  TO  2?0 
(H  .EQ.  Ndd)  60  TO  lio 
(H  .EO.  RHCO)  60  TO  las 


IF  

66  WRTTF(A«2«0) 

66  FORi*AT(«  ERROR  ON  OPTION  CARD*) 
60  TO  ioS 
2T0  L06  » i 
60  TO  ?87 

60  TO  2«7 

|r7  J^«^F?NOli«CARO.COL«EOyCOM) 

II  ill- 

COLOR  CODES 

200  NPI.STQ 
ADR 


NC  • NOCHaN 
N0SUR2 


VECSCN (MEANS (AOR*l)tNOCHAN*CARO*COU  ♦ NCLSTR 
NCLSTH*NOCHAN 


NCLSTR 

2 


CLRKFY 
60  TO  105 


Tape  size  card 


300 


310 

315 

3?0 


K/XTCHM(CARD.( 


(M  ,fQ.  RLANK?°bo  TO  105 


Xftco) 

YRC01 


60 

GO 


TO 

TO 


3^0 

330 


H 
IF 

IF  (M  ,E0, 

IF  1**  (EOi 
WRITE(315) 

FORMAT (•  ERROR  ON  TAPE  SIZE  CARD*) 
60  TO  106 

M > NXTCH«(CARO*COU 
J » FIN012(CAHn*C0L*EQUC0M) 

IF  (M  ,EQ.  SHCD)  CSCALE  « 1 
■“  (J  .'■‘E.  2)  GO  TO  310 

> NUMeFRtCARD»COL«JtZERO) 

{*'  .EG.  HmCO)  XMl  » J 
(M  .EO.  LRCD) 

.to.  SHC' 

COL  - 1 


IF 

MM 

IF 

IF 

IF 

COL 


‘D> 


XLO  9 
XSIZ 


330 


MM 

IE 


YLO  «! 
YSIZ  s 


340 


C' 

i 


350 

F 

3T0 

3A0 


60  TO  300 
M s NXTCHH(CaRO*COL) 

IF  (M  .NE.  SRCO)  SCSALE  » 1 
J » FIN012(C APn.cOLtEQUCOM) 
IF  (J  .‘It.  2)  60  TO  310 

* NUM0tR (CARO. COL»J» ZERO) 
(M  .FO.  HhCO)  YHI  « J 
(M  .EO.  LmC.O)  YLO 
TF  (M  .EQ.  5HC0) 

COL  « COL  - 1 
60  TO  300 

SYMBOLS  CARD 

M s NXTCHW(CA«D»COL) 

IF  (M  .FG.  PLANK)  60  TO  105 
IF  (M  .FO.  KOMMA)  GO  TO  340 
ICNT  * ICNT  ♦ 1 
SYMMTX  (ICNT)  9:  M 
60  TO  340 

MODULE  STAT  CARD  DECK 

CALL  CPDSTA (PUFF. TOP) 

60  TO  105 


DATE  CARD 


M 

TF 


NXTCHM( CARO. COL) 

( M ,EU.  PLANK)  GO  TO  105 


RFAO(30.3rt0)nATE 
format (10X.15A4) 
PEWINO  30 
60  TP  105 


iTOlSRO 
^T0l640 

mtii 

111  sis 

?np 

TO  720 

Ml 

i?| 

liijsss 

J.T0I870 
SET018A0 

IllSilSS 


III 

790 

m 

620 

830 

840 


,;T01910 
SCT01920 
SET0I930 
SET01940 
SET01950 
SET01960 
SET01970 
S|T019«0 
SET0I99O 
SET02000 
SET02010 
S|T020|o 
SF702030 
SET02040 
SET02050 
SET020t»0 
SET02070 
StT02080 
SET02090 
SET02100 
S|T02ll0 
SET02I20 

IIISIUS 

SET02150 

SET02160 

StT02170 

SET021R0 

SET021R0 

5ET02200 

SET02230 
SET 02240 
StTO?250 
5tT02260 
StT0?270 
SET022A0 
SET02290 
5ET02300 
SET02310 
SET02320 
Sfc  T02330 
SF  T02340 
Sttn2350 
SET02360 
SET02370 


FILFI  SCTll 


C 


S 

c 


8 


8 


340 


*to 


CO*'*ieNT  CARO 
r'  m NXTCHR(CARn*COL) 
'1.  RLANmlO 


■ I# 

1 


HCOl 
AAO  M ■ NXTCHR( 


JgijpoTcS^CNT 


TO  105 


M ■ NXTCHR(CARO*COk) 

IF  (M  .FO,  RLANKJ  60  TO  105 
$FA0«10i3SO)'hEOI 


Arxio* 
WINd  3 
TO  10 


HC02 

M ■ NXTCHH(CAR0«C0L> 

- : - ; _ u 8 ■ 

;*n(3(t.3ilO)  HE02 


JF^iM..fO.  Rl.ANK[  60  TO  105 


EAnoo.S: 

lx\u 


SCATTER  Plot  tape  CARO 

A15  M ■ NXTCPRJCAROtCOLI 

TF  (M  .PG.  PLANK)  60  TC  105 
}F  (K  .EU.  IJHCO)  60  TO  AlO 
410  W«1TP(A.4i7) 

417  formats  ERROR  ON  SCATTER  PLOT  TAPE  CARO*) 

60  TO  ms 

41P  J ■ FIN01?fr''Pf),C0L»E0UC0R5 
IF  .'n-  ’»  ^<0  TO  416 

M m N!J‘'  ! i^fCAwr. COL* SCTRUN* ZERO) 

60  TC  ; lb 

R - ►•'iPix  card 

RMKfv  - j FOr-  CAROS 
RMKfY  r i FOR  FILE 


4?0  M ■ i.;;iCHR{CA«OiCOU 

IF  (M  BLANK)  GO  TO  433 

IF  (M  .f-0.  CBCO)  GO  TO  *iO 
IF  (M  .to.  FRCO)  60  TO  450 
433  WRTTF(s.435) 

435  FORR>!t»  ERROR  ON  B-HATRlX  CARO*) 

60  T'l  ins 

440  RHKF--  r I 

CALI  9MFIL (SMATRX.BMCOMB*BNF£AT»BHVEC*0MKEY) 
fiO  iO  105 
450  RMKPY  « ?. 

CALL  BHFIL (RHATRX*BHC0MB«BmFCaT«8HVEC*BHKEY) 
60  iO  105 


B-CR  GROUND  COLOR  CARO 


455  N " NXTCHRtCAPO.COL) 

«R  .FO.  BLANK)  GO  TO  1(?5 
;*  (M  .‘^n.  MRCO)  RCKC-NO  s 0 
(f  (R  > J.  WMCO)  5CK6N0  a 255 
60  TO  ioS 


R VECTOR 

460  NBVCHN  > F Ttn-NCAROfCOLfBVECLNBVCHN*!)  *30) 

60  T"^^  10^' 


SCALING  CARO 

470  R * NXTCMRtCAPD.COLJ 

, TF  (P  ,F0,  HLANk)  go  to  105 
IF  (M  ,E0.  FRCO)  60  TO  471 

TF  ,FC.  Y-^Cn)  GO  TO  472 

TF  (-  .*0.  XMCO)  60  TO  473 

IF  (M  .EG.  HHCO)  60  TO  476 

GO  TO  474 

471  SCALKY  » 2 
GO  TO  105 

4711  .)  « FIN012(CAPn,COL»EOUCOM) 


♦ NBVCHN 


■T023BO 

•T0i?3R0 

ntm 


f) 


fT02640 
5CT02650 
SET 02660 
ET0|670 
tT02680 
■T02690 
iT0?700 
*T02710 
iT02720 
SFT02730 
SET02740 
SET02750 
SET0|7G0 
SE  02770 
Sn  02780 
SET02790 
SETOj  “ 
SETO* 
SETOt->, 
SET02830 
SET02B40 
S|TO|eSO 
SET02&60 
SET02870 
SfT026«0 
S|T02890 
ET02900 

[7^29^8 


1 

:T02930 

SI 

= TOi 

»V40 

SI 

^Tol 

>9se 

SI 

[to: 

)960 

SETOJ 

>970 

I! 


-iT02980 
SfT02990 
SET0300D 
‘1T03010 
.‘T03020 
Sf T03030 
SET03040 
SET03050 
SET03060 
SLT03070 
5ET030R0 
SET03090 
SET03100 
SET03110 
SET03120 
SET03I30 
SET03I40 
srT03)S0 
SET03160 


3i3 


riLCf  SCTIJ 


AAir  COLOR  CODf5  COMING  FROM  TaRC 

IF  (NCLRCH  .FQ*  01  GO  TO  SOS 
ClRKCT  ■ 2 
NC  • NCLRCH 
SAS  y ( TOTMNS  .CO. 


SETA 


c tSVmns 

RKFY  ■ A 
mC  ■ N0FCT2 
SAO  CONTINUE 


01  GO  TO  SOO 


POSITION  TO  OESIREO  FILE 


“^'^|SroR*InIpoIi?10nINO  N-OIM  mist  FILE  TO  FILE** 


51 A foomati*  error 


. >R  IN 
•IS/'  ISTaT  ■ »tI5» 
REWIND  NHSTUN 


SPA 


CALL  CMfRR 
CONTINUE 


WRTTF(«t.7A0) 

F <FRFO  .FD. 

■ (LOG  .FO. 

(PMfrry  ,Qf. 

(PCXOnO  .FO. 
(«CFr»NP  .Eo. 
(RSCALF  .Fi). 
(sr*L«Y  .r>7. 
(SC»LK 


7AA 

71A 

7PA 

740 

7A0 

74A 

77A 

7RA 

7AO 

AOO 


F 

F 

F 

F 

F 

IF 

IF 

IF 

“F 

F 

F 


n 

WRl 

TF (fc.Tl 

1) 

wRl 

TE(S.T2 

0) 

w 

RlTt («♦ 

01 

A) 


01  MR] 


III 


<CLR«l 

(fLPwi 

(CLO" 

<fLR» 


cv  .FO,  |) 
■Y  .FO.  !) 
Y .Et^. 


25S»kRITE(6,760) 

0 .AND,  tt**KEY  ,GT. 
2 .Ar»ri.  OMKCY  .GT< 


0) 

01 


MR|TF(6*770) 

MRiTF(G*760) 


.F(5.- 

.FO, 


format (//•  USER  HAS  SFLECTEO^T 
LINF  BRINTFR  PIXEL  FB 

Inf  printer  log  of 


t>RITC<A«790) 

WBITF(n.AOO)  (FETVECd)  •IbIyNOFEAT) 
waiTE(6«AiA) 

MR|TE<6*StO) 

WRITE (4.A5g» 


format ( 

FQPMAT ( 

format ( 
format  ( 

FORMAT ( 

format ( 

FORMAT ( 

format ( 
format ( 

4 (IX 
A1A  FORMxt( 

p-xo  format  ( 
Apn  format < 
•niM  mist 
RETURN 

END 


'Iban^FORm  oATA‘) 
t-IACK  GBOUNO  COLOR  FOB 
HACK  GROUND  COLOR  FOR 

tbansformfo  oaTa  will 
usfk  has  input  BFSCAlIMG 
RESCALING  factors  MILL 


«! 

IpIc^RAL  plo? 

NOT  8E  RESCAL 


NG  OPTIONS  i*f//I 
PLOT • » 


II 


K») 

EM 


Color 

12) ) 

COLOR 
COLOR  . 

color  cooes 
f ILEM 


CODES  ABE  COMING 


FA^TORSl) 


ifili 

■TOAUO 
d04l20 
‘T04130 
■TOaIaO 

,nitm 

i^TOAlTO 
IIOAIAO 


HE 
FROM 


MPutCO  FROM  n-OIM  MIST  FILE* 
stat  file  using  CMANNELS  *t 


CODES 

Cooes 


are  coming  from 


INPUT*) 

Ml 

abI'coming  from  radiance  valu 


WILL  'Hf  COMPytEol^^loH ■ FIElO 


ANS*) 

S STORED 


ON  N- 


iO 

•t04230 
■T 04240 
^ET04?50 
;T04260 

setoa! 

Mtm 

iET04370 
>ET043R0 
J04390 
T04400 
;T04410 
T04420 
SET04430 
SET04440 
SET044S0 
SET04460 
SET04470 


FILFJ  SORTVC 


SUnROUTlNC  SORTVC (HISTtPNTRt ICOL*NOVeC« IRG* lEN* II ) 

SORTVC  SORTS  THE  ARRAY  HIST  INTO  DESCENDING  ORDER 

HIST  - THE  ARRAY  TO  RE  ORDERED 
PNTR  - ARRAY  CONTAINING  POINTERS 


ICOL  - THE  COLHHN  WITHIN  HIST 
NOVEC  - NO.  OF  VECTORS  TO  SORT 
IB6  - ARRAY  CONTAINING  BEGIN 


That  is  to  be  ordered 


IFN  - array  CON'UINING  ENDING  PO^^ 
11  - NO. , OF  block  being  sorted 

IMPLICIT  INTEGER  (A-Z) 

REAL  HIST(IC0L«N0VEC)*NUMBR 

DIMENSION  PNTR(l) 

DIMENSION  IB6(lf*IEN<l) 

IB  » 1 
IE  « 1 
NEXT  B IB 
DO  200  J=l. NOVEC 

NUMRR  X hIST(ICOL»J) 

COMPARE  against  LARGEST  NUMBER 

IF  (NUMRR  .GE.  HISTdCOLtIB) ) GO  TO  100 

COMPARE  against  SMALLEST  NUMBER 


IF  (NUMRR  ,LE.  HIST(ICOL.IE))  GO  TO  120 
coMpAPF  against  next  largest  number 

TNTPY  = PNTR(NEXT) 

NOVFCl  a J - 1 
DO  BO  Isl.NOVECl 
PAST  = NEXT 
NF*T  = PNTR(NPXT) 

IF  (NOMPR  .GF.  HIST (ICOL.NFXT) ) GO  TO  130 

IF  (NUMuw  .GT.  HIST(ICOL.INTRY) ) GO  TO  130 

past  = INTRV 

INTRY  ■ PNTR(lNTRY) ’ 

rONTTMJs 

RRTTF (G.90) 

FORMAT (♦  ERROR  IN  SORTING  VECTORS') 

STOP 

LARGEST  NUMBER  FOUND  THUS  FAR 

PNTR(J)  * IB 
IB  = J 
NEXT  a 18 
GO  TO  200 

smallest  number  found  thus  far 

PNTP(IE)  a J 
IE  = J 
GO  TO  200 


INNING  POINTER  FOR  EACH  BLOCK  SORTED 
1N6  POINTER  FOR  EACH  BLOCK  SORTED 


\T  p. 


PNTR(J»  a next 
NEXT  a JO 
PNTP(PAST)  a J 
CONTINUE 

TBG(II)  a IR 
TEN (I  I)  a IE 
RETURN 


3/^ 


r»r»r»  or>ooo  non  non  non 


FILPS  5T0F1L 


C» 

c* 

c* 

g 

c 


SUBROUT I NE  STOP 1 L ( L I H I T # ME  ANS . BUFF ) 

STOFIL  READS  AND  STORES  NDIM  FILE  ON  DRUM 
IMPLICIT  INTEfiER  (A-2) 


INCLUDE  CMB<12.LIST 
INCLUDE  C0MM?OS,LIST 

COMMON/GLOHAL/HEAO (61) «MAPTAP.DATAPE*SAVTAPtRMFlLEiBMKEY. 

hISFIU.HISKEY,TREORM,ERIPTP.ERPKEY»MAPUNT»NOFILE* 

^ ORUMAO  » ORMNOS . P AGS  1 Z . 0 ATE  I L . ST AF IL ♦ AS AV , ASAVFL 
•NhsTUN»NHSTEI»SCTRUN»MAPF1L 

»DOTUNT.nOtFIL.NCHPAS.TRNSEL*BMTRFLtMlSTFLtPCHUNT* 

CRDUMTtPPTUNTtPANDIO 

COMMON/SCTTEB/RSCALE»XYSCLE»CLHVEC(30).NCLRCH,CLRKEY.L06» 
FRFO,XMAX,YMAX«XMlN,YMlN»BCKGNO«XHIfXLO»YLO.XSIZ» 
YHltYSI2.NRINS.3YMMTX(32) .PMAThX (60) *PVEC ( 30) «NRVCHN«N0FEAT 
»5CALKY,mena0P»FL0A0R.PNTA0R»I0A0R.NC.BMEEAT,BmC0M8 
«NnvEC«TOTMNS*SI?F,DRMIDfORHl01*DRMCLR*ORMCRl«ORMTNSfORMTNl» 

drmcnt«drmcti,dpm*ec»dmmvci.vectri.datai.nvec*noread.lreao 

.DR^PTR.DRMPTl,FETVEC(l6) tORMPLTtCSCALE 
♦NOSUH 


dimension  6UFF(1)  ,1STAT(4,2)  .ISTA(3»2).MEANSm 
DIMENSION  REmDR(A) 


PEAO  means  into  core 

IF  (CLPKEY  .EO.  *)  READ (NMSTUN) (MEANS (I) .I»I»T0TMNS) 

AMT  = 0 

TOTAL  = NOVEC*SIZE 

DO  l(»n  Isl,A 

PEMO  = TOTAL  - LIMIT*I 

IF  (PFMn  .GT.  0)  GO  TO  90 

RFMOR(I)  = TOTAL  - LIHIT*(1-1) 

NTPRDS  s 1 
«0  TO  105 

pn  REMOR(I)  = LIMIT 
100  CONTINUE 
105  CONTINUE 


READ  IN  REC  4 ~ DATA  VECTORS 

DO  130  I=l«NTPROS 
NOWRDS  = REVDR(I) 

READ  (NHSTUN) (5UFF(J) »Js1*N0WR0S) 


DUMP  ON  HIGH  SPEED  FRUM 


CALL  PWHITF  (ORMVClfBUFFd)  .NOWROSf  ISTAT(I.I)) 
DRMvri  = Oh'^VCI  ♦ NORRDS 
no  CONTINUE 

IF  (CLPKEY  .FU.  3)  NOREC  = 3 
IF  (CLRKEY  .NE.  3)  NOREC  =2 

READ  IN  RFC  5 — 10  ARRAY 
READ  IN  RFC  6 — COUNTERS 
READ  IN  REC  7 — COLOR  CODES 

DO  200  K=l. NOREC 
NOWRDS  = NOVEC 

READ(NHSTUN)  (8UFF(J) *J=1. NOWRDS) 


DUMP  ON  HIvjH  SPEED  DRUM 

IF  (K  .EQ.  1)  GO  TO  170 

IF  (K  ,F.O.  ?)  GO  TO  lAO 

IF  (K  ,F0.  3)  GO  TO  190 

170  CALL  RV'RITF(ORMI01.BUFF(1), NOWRDS. ISTA(K,D) 
nRMim  = DwMiol  ♦ NOWRDS 
GO  TO  ?on 

IPO  CALL  0“RITF(ORMCT1.RUFF(1).NOWPDS»I5TA(K.1)) 
DRMCTl  s OPMCTl  * NOWRDS 
GO  TO  ?on 

loO  CALL  R'W«ITfc(OHMCHl,PUFF(l)»NOWROS.lSTA(K.l)) 
DRMCR]  = DR-'CRl  ♦ NOwROS 

200  CONTINUF 


STOOOOlO 

ST000020 

ST000030 

ST000040 

ST000050 

STO()0060 

ST000070 

STOOOOBO 

COMOOOlO 

COM00020 

COM00030 

COM00040 

COM00050 

COM00060 


)11 

)|!8 


STOOOlOO 
STOOOIJ ■ 

sTooor 
STOOol 

ST000140 

ST000150 

ST000160 

ST000170 

SToooiao 

ST000190 

ST000200 

ST000210 

ST000220 

S7000230 

ST000240 

ST000250 

ST000260 

ST000270 

ST000280 

ST000290 

ST000300 

ST000310 

ST000320 

ST000330 

ST000340 

ST0003SO 

ST000360 

ST000370 

ST000380 

ST000390 

ST000400 

ST000410 

ST000420 

ST000430 

ST000440 

ST000450 

ST000460 

ST000470 

ST000480 

ST000490 

ST000500 

ST000510 

STU00S20 

STOOOS30 

S7000540 

ST000550 

ST000660 

ST000570 

ST000580 

STO00S90 

ST000600 

ST000610 

ST000620 

ST000630 

ST000640 

STooneso 

ST000660 


file:  stofiu 

CALL  FSBSFL(NHSTUN,l.ISTATl) 

RETURN 

END 


STO006T0 

ST00066Q 

STO00e90 


nnn  nnnnnnn  non 


F!LC»  TNSFER 


CSEND 

8 


10 


SUBROUTINE  TNSFER  < PLOT ♦ TNSOAT ,NVECT  » I AAA ) 


TNSFER  TRANSFORMS  1 - 16  CHANNELS  TO  2 COMPONENTS 

IMPLICIT  INTEGER  (A-7) 

REAL  XMAX*YMAX*XMINfYHIN 
REAL  TNSOAT 


jNCLuni 


COHRKl.LISI 

C0MR|<6.lIsT 


NCLUDE  

TNCLUOE  CM?Kf2,LIST 
COMMON/INFORM/NOCLS2«NOSUP2.NOFET2«VARSZ?.TOTVT2»NOFL02* 

AVAR?.COVAR?»CLSI02»SUflN02.SU«OS2.FLOSV2tVE«TX?t 
FETVC2(30) tSUPVC2(7S) .SUMPTR (751  *CLSVC2 (60) t 
KEPPTS(60) »N06RP»GHPNAM(60) «GRPDEX(61)« 
GHPCHK(61) »6R0UPS(12A) 

COMMON/GLOBAL/HEAD (63) »maptap»datape»savtap*bmfile*bmkey» 


•YtMAPUNTfNOFILEt 

Uvfl 


HISFIL.HISKtY»TWFORM»E«IPTPtERPK| 
ORlJMAOfnRM*DS.PAGSIZ»OATFILfSTAFIL*ASAV*AS 
♦NHSTUN.NHSTFl.SCTRUNtMAPFiL 

♦DOTDNT^UOTFILfNCHPASfTRNSFL.BMTRFLfHISTFLtPCHUNTt 
CRDUNT,PPTUNT,RanOIO 

^ ^ ^ CLRKEY*L06# 

XSIZf 

. _ )fNBVCHN*NOFEAT 

tSCALKY*MFNADR.FLnAD«»PNTAOW»IOAOR»NC*BMFEAT»BMCOMR 
»NOVEC»TOTwn>»SIZF*DR«IO.ORM101*ORMCLH»DRMCR1.DRMTNS»ORMTN1, 
DRMCNTtDR'^CTl .DRMVEC»OHMVC1*VECTR1.0ATA1»NVEC»NOREAD»LREAO 
♦DRMPTR.DRMPTI tFETVEC ( 16) tORMHLT »CSCALE 
fNOSUS 

DIMENSION  DATA(16) ♦PL0T(S1ZE»NVECT) »TNSDAT(2tNVECT) 


THUUN  I * r*K  I UN  I fHONUlU 

rOMMON/SCTTFP/RSCALE.XYSCLE*CL«VEC(30) .NCLRCH*CU 
FPF0.XMAX*YMAX*XMlN«YMlN*bCK6ND»XHltXL0»YL0tXSl 
YHI,YSIZ«NRINS»SYMmTX(3?) .BMaTHX(60) *HVEC(30) 


LOGICAL*!  LDUM(4) tLLOUM(A) 

FOIJIVALENCE  (IDUK.L0UM(1))«(II0UM,LL0UM(1)) 

DO  100  Isl.NVECT 
no  10  I1=1.N0FET2 
TI1=(IT-1)/4*1 
IRYTF=II-( (1I-1)/4)*A 
IOtlM  = PI.OT(IIl*l) 
lim.iw=o 

LLni)M(4)=LD'JM(IBYTE) 

DATAdDsIIOUM 

TRANSFORM  DATA  VECTOR 

CALL  MATTNS(BMATKX.OATA*TNSOAT(ltI) ♦BVECtBMCOMBtBMFEAT) 

PSCALKY  = 1 USER  HAS  INPUT  SCALE  FACTORS 
R SCALKY  = 2 COMPUTE  SCALE  FACTOHS 


USER  HAS  INPUT  scale  FACTORS 

IF  (SCALKY  .EQ.  2)  60  TO  20 
SWTCH  s 1 

IF  (RSCALE  .EQ.  1)  CALL  RFSCLE (TNSOAT ( 1 . I ) ♦SWTCH. NVECT) 
GO  TO  100 

YMAX.  XMAX.  AND  XMIN  APE  TO  BE  TAKEN  FROM  HIST  FILE 


20 

IF 

( I .NF.  1)  60  TO  25 

IF 

( II  .NE.  1)  GO  TO  25 

XMIN  = TNSnATtl.I) 
YMTN  s TNSI)AT(?.n 

. 

IF 

(XMak  ,LT.  TNSnAT(J.I)) 

XMaX 

r 

TNSOAT (1. 

1) 

IF 

(X/ATfg  .GT.  TNS04T(i.l)) 

XMIN 

s 

TNSOAT (!♦ 

I) 

IF 

(YMAX  .LT,  TNSnAT(2.D) 

YMAX 

s 

TNS0AT(2. 

I) 

IF 

(YMIN  .GT,  TNSfiAT(2.I)  ) 

YMIN 

s 

TNS0AT12. 

I) 

100 

CONTINUE 

PFTURN 

ENO 


TNSOOOlO 
TNS00020 
TNS00030 
TNSOOOAO 
TNSOOOSO 
TNS00060 
TNS00070 
TNS00080 
TNS00090 
TNSOOlOO 
TNSOOIIO 
TNS00120 
TNS00130 
TNSOOUO 
TNSOOiSO 
TNS00160 
TNS00170 
TNSOOISO 
TNS00190 
TNS00200 
TNS00210 
TNS00220 
TNS00230 
TNS00240 
TNS002S0 
TNS00260 
TNS00270 
TNS002S0 
TNS00290 
TNS00300 
TNS00310 
TNS00320 
TNS00330 
TNS003A0 
TNS00350 
TNS00360 
TNS00370 
TNS00380 
TNS00390 
TNS00400 
TNSOOAIO 
TNS00420 
TNS00430 
TNS00A40 
TNSOOASO 
TNS00460 
TNS00A70 
TNS00480 
TNS00490 
TNS00500 
TNSOOSIO 
TNS00520 
TNS00530 
TNS00S40 
TNS00550 
TNS00560 
TNS00570 
TNSOOSRO 
TNS00590 
TNS00600 
TNS00610 
TNS00b20 
TNS00630 
TKSO0640 
TNS00650 
TMSOObOO 
TNS00670 
TNS00680 
TNS00IS90 
TNS00700 
TNSO071 0 
TNS00720 
TNS00730 
TNS00740 
TNS007SO 


5/^ 


FlLFt  UNPCKV 


C* 

C« 


SUBROUTINE  llNPC^V(PLOT•TNSDAT«NVECT) 

UNPCKV  UNPACKS  T«>0  9 BITS  BYTES  AND  STOES  THE  VALUES  INTO  TWO 
FLOATING  POINT  WORDS 

implicit  integer  (A-Z) 

PEAL  TNSDAT(2«NVECT) 

* 

rOMMON/SCTT&i/pkc6LE*XYSCLF,CLPVEC(3n) ♦NCLPCH*CLRKEY»LOG. 
FPFQtXKAX.YMAX,*MlN.YMIN»BCK6N0»XMl»XL0*YL0»XSIZt^ 
YHl.YSIZtNPINS.SYMMTXO?)  «PM»THX(60)  tHVECOO)  ♦NPVCHN«NOFEAT 
.SC«LKY»wENinp«FLOAOPtPNTADP*IDAOP»NC.8MFEAT»BHCOMR 
,NOVEC.TOTvNS*sT2E»OPMiD,OPMIONOHMCLPfDRMCRliyPMTNS.OPMTNl. 
0PPCNT«0P*'CTl»0PMVECtURMWCltVECTPl»DATAl*NVEC»N6HEAD«LREA0 
, ORMPTP , DPMPT 1 * FE T VEC (1 ft  > » OHMPLT  * CSCALE 


«r 


CSENO 

C 


►NOSUB 


100 


LnuM(4) ,LLOUM<4) 

E (LDUM(l) tIDUM) t (LLOUM(I) tllDUH) 


DIMENSION  PLOTU) 
LOGICAL*!  ■ 
EQUIVALENC 

DO  100  I*ltNVECT 
IDUMePLOT(I) 

IinilMsO 

LLnUM(4)»L0UM(2) 
V4LUF?sIIOUM 
LLDIJM(4)sL0UM(1) 
value  1*1 IDUM 
TNSDAT(?,1)  s value? 
TNSOATdtl)  = VALUE! 
peturn 
END 


UNPOOOIO 

UNPOOOtO 

UNP00030 

UNP00040 

UNPQOOSO 

UNP00060 

UNPOOOTO 

UNPOOORO 

UNP0Q090 

UNPOOIOO 

uNPoono 
UNPooito 
UNP00130 
UNP00140 
UNP00150 
UNP00I60 
UNPOOITO 
UNPOOIAO 
UNP00I90 
UNPOOfOO 
UNP00210 
UNP00220 
UNP00|30 
UNPA0240 
UNP00250 
UNP00260 
UNP00270 
UNP00260 
Ui'JP  00290 
UNP00300 
UNP00310 
UNP00320 
UNP00330 
UNP00340 
UNP00350 
UNP00360 


noo  or»r»  on  ooo  ooo 


FiLf-J  VECSCN 


i 

^ 110 


l?n 


no 


1?? 

133 


I4n 

l=i0 

,?n0 


FUNCTION  VECSCN (VFCTPfNVCFLT*CARO»COU 

VFCSCN  CQNVS-WTS  ALPHA  CHAPACTFS  TO  INTEGERS 

RETURNS  The  no,  of  ELFMENTS  WITHIN  A SET  OF  PARENTHESIS 

RETURNS  ThE  no,  of  PAPEnThESIS 

IMPLICIT  INTEGER  (A-Z) 

DIMENSION  VECTR(l) ,C0HMA(2> ,CARO(l» 

OATA  STAR  /•*•/, blank/*  */,LP8CD/* ( */«RPRCD/* 1 •/ 

DATA  COMMA/1, -A,  */,K0Mma/*,i/ 


NT IMPS  ■ 
TOTNUM  « 


TOTNUm  3 TOTNUM  ♦ 1 
NVCELT  3 NVCELT  ♦ 1 
M 3 NXTCHR (CARD, COL) 


TF 

(M 

,FQ. 

BLANK) 

GO 

TO 

140 

IF 

(M 

,CQ, 

LPBCD) 

60 

TO 

po 

TF 

<M 

,F0, 

»P«CD) 

GO 

TO 

130 

TF 

(V 

,FQ, 

KOMMa) 

GO 

TO 

120 

IF 

(M 

,E0, 

STAR) 

GO 

TO 

135 

CHANGING  NUMBER  FROM  ALPHA  MODE  TO  INTEGER  MODE 


CALL  I4A1HN(CARD(C0L)  ,1»NIIM) 
numb  s 10*NUM«  ♦ NUM 
IF  (NUM  ,LT,  0 .OM,  NUM  ,GT, 
GO  TO  100 

FOUND  A comma 


9)  GO  TO  150 


VFCTR (TOTNUM)  a NUMB 
NU“B  = 0 
GO  TO  BO 

FOUNO  A • ) • 


VFCTP (TOTNUM)  r NUMB 
NUMB  = 0 

IF  (NTImFS  .FO.  0)  GO  TO  133 

no  13?  1 = 1, '(TIMES 

no  13?  J=1  .“JVCELT 

JJ  3 TOTNUM  ♦ (I-))*NVCELT  ♦ J 

WFrT»(JJ)  = VECTR (TUTnum-NVCELT^J) 

TOTNUM  3 TOTNUM  ♦ NT IMES*NVCELT 

NTTMFS  3 0 


J 3 riND12(CARn. COL, COMMA) 

IF  (J  ,FO.  -1)  60  TO  140 
NVCELT  3 u 
GO  TO  BO 

FOUND  A MULTIPLICATIVE  FACTOR 
MTIMFS  3 numb  - 1 

FMJMH  3 0 

GO  TO  100 

FINISHFD  SCANNING  CARD 

VFCSCN  3 TOTNUM/NVCELT 
RETURN 

VFCSCN  3-1 
urTTF  (*>.?00) 

format (•  ERROR  OCCURRED  SCANNING  VECTOR  CARD*  ) 
return 

FNO 


VECOOOlO 
VEC00020 
V|C00030 
VFCOOOAO 
VECOOOSO 
VEC00060 
VEC00070 
VEC00080 
VEC00090 
VECOOiOO 
VECOOilO 
V|C00120 
VEC00f30 
VEC00140 
VEC00150 
VEC00160 
VEC00170 
vECOOleo 
VEC00190 
VEC00200 
VEC00210 
VEC00220 
VEC00230 
VEC00240 
V|C0025Q 
VEC00260 
VFC00270 
VEC00280 
VEC00290 
VEC00300 
VEC00310 
VEC00320 
VEC00330 
VEC00340 
VEC003S0 
VEC00360 
VEC00370 
VEC00380 
VEC00390 
VFC00400 
VFCOOAiO 
VEC00420 
VEC00430 
VEC00440 
VfCOOASO 
VEC00460 
VEC00470 
VEC00480 
VEC00490 
VEC00500 
VFC00510 
VEC00520 
VECOC530 
VEC00S40 
VEC00550 
VFC00560 
VEC00570 
VEC00580 
VEC00S9O 
VEC00600 
VEC0061 0 
VEC00620 
VEC00630 
VFC00640 
VEC00650 
VEC00660 
VEC00670 
VFC00680 
VFC006R0 
VFC00700 
VECO0710 
Vf C007?0 
VEC00730 


ooo 


X7.  DOTDATA  PROCESSOR 


FlLFt  OOTOAT 

OOTOAT  IS  THE  DRIVER  ROUTINE  FOR  THE  OOTDATA  PROCESSOR 
SUBROUTINE  OOTOAT (ARRAY*TOP) 

01 MENS I ON  ARRAY (1) 

CALL  OOTS?ARRAYU).ARRAY(500l).ARRAY<600I>.TOP) 

RETURN 

END  ' 


ni,’ 


QUAjJfy 


FILFJ  DOTS 


- - «A-Z) 

n«TA(SIZCfI)«IDATA( 10000) 


FL  (12)*  VERTEX  n> 


DOTS  IS  THE  CO-OROINATOR  FOR  CREATING  THE  DOT  DATA  FILE 

SURROUTTNE  nOTS(OATA»FIELOS»VERTEX*TOR) 

IMPLICTT  ■ “ 

dim|nston 

niMgNSTON  FIFLOSU.l)* 

INCLUOF  C0M^K1,LIST 
INCLOOF  C0MMK6,l|ST 
INCLUOF  CMflKl*,LfST. 

INCLUDE  CHRKl^tLlST 

COMMON/INFOftH/NOCLS2*NOSUR2»NOFET2.VARS22.TOTVT2,NOFL02* 

AVAR2.COVAR?«CLSIO?«SURN02«SUROS2*FLOSV2«VERTX2* 
FETVCZOO)  »SURVC2(rS)  *SUflPTH(75)  *CLSVC2(60)  ♦ 
KEPPT5(«0) *NOORP*GRPNAM(60) *GRP0EX(61) • 
6RPCMK((.l)  .RROUPS(12*I 
COMMON/GLOB AL/HF AO (63) »HAPTAP,0ATAPF 


P?L'^‘f>.rPBy!!0SiPA6§.IZ.»OATFIL»STAFlL*ASAV»A5AVFL 


^nr,«u  »ri«r  I «r«ua  I mrr  i At'asnr  iLtfonKCT* 

HlSFIL*HiSKEY*TRFOPH*FRIPTP*ERPKEV.MAPUNT»NOFILE* 


.NHSTUN.NHSTFltSCTRUN*MAPFIL 

.DOTUNT*OOTFTLfNCHPAS*TRNSFL*BHTRFL*HlSTFL.PCMUNT» 
CR0UNT*PHTUNT.RAN0I0 
COMMON  /0OTVEC/TYPE»CaTNAM(60) *N0CAT*T0TVEC*FL0INF(6) *prtkey 


CSENO 

c 


»S1ZE 

COMMON/ ISOLNK/SUNANC 


f 

(8 


UNT  « I SUNC  « SMSTR  * SHSTP  « SM 1 NC  * L I NSKP 


C 

c*** 

c 


PATA  BLANK/*  */ 
NOSUN  « e 
TSUNT  ■ 1 
tSUNC  • 0 
STAMNT  « 1 
SWTCH  B O 
IPT  s 1 

IF(LACIE.NE.O) IPT 


CODE 


ADDED  NOV 


0 
21* 


1978  TO  SUPPORT  LIST  PROCESSING 


90 


ZERO  « 0 
SWCH6  * 0 
NOCAT  ■ 0 
NOFLD2«0 
TYPE  a I 

initialize  image  PATA  TAPE 
CALL  TAPHDR(DATAPE*DATFIL) 


8S 

C 

c«*« 

c 


no  80  1*1, size 
00  80  Jal.TOTVEC 
PO  PATAU, J)  • 0 
T0TVT2  * 0 
TOTVEC  « 0 
IFtLACIE.EO.DCALL 
•VEOTEX) 


FLOLAC(FIELDS*STAMNT*L100*i5lO*fcS20*IPT* 


ADDED  NOV  21,  1978  IN  SUPPORT  OF  LIST  PROCESSING 

IF  (LACIE.6T.1)  CALL  LISTLC(FIELDS,STAMNT*LlO0*iS10* 
* 4.8?n,Sv'rMG,  IN  1t,LACTe,ZEmO,  IPT, VERTEX) 

CALL  FLUT YP  (F  lELDS, ST AMNT, MOO, LSI 0.A520*  IPT* VERTEX) 


100  LINSTR 


FLPINF(I) 

FL0INF(2) 

FL^I^!F  (3) 

FLOINF(A) 

FLr>INF(5) 

FLOINF (6) 

FIFLnS{?,N0FLn?)  B NOCAT 

T0TVT2  s FIEL0S(4,N0FL02)  ♦ T0TVT2 


LINEnD 

LININC 

SAMSTW 

SAM£N0 

SAMINC 


ILINE 

NSAMP 


(LImFN0-LINSTR)/LIN1NC 
(SAkiKNO-SAMSTW)  /SAMINC 


POSITION  IMAOE  TAPE  FOR  THIS  FIELD 
CALL  FLniNT(FLOINFU)  ,FETVC2»N0FET2) 


DOTOOOIO 

OOT00020 

DOT00030 

OOT00040 

pOTOOOSO 

OOTOOOGO 

OOT00070 

DOTOOOep 

DOT0Q090 

DOTOOlOO 

DOTOOlIO 

esmiiii 

DOTOOUO 

POTOOISO 

DOT00160 

DOT00170 

DOT00180 

OOTO0I9O 

OOT00200 

00T00210 

DOT00220 

OOT00230 

OOT00240 

88f88IIS 

OOT00270 
DOT00280 
DOT00290 
DOT00300 
D0T00310 
0OT00320 
DOT00330 
OOT00340 
OOT00350 
OOT00360 
OOT00370 
DOT00380 
PJl 00390 
OOT00400 
OOT004I0 
DOT00420 
DOT00430 
OOT00440 
0OT00450 
OOT00460 
DOT00470 
OOT00480 
OOT00490 
OOT00500 
OOTOOSIO 
DOT00520 
DOT00530 
DOT00540 
DOT00550 
DOT00S60 
OOT00570 
DOT00580 
OUT00S90 
DOT00600 
DOT00610 
DOT00620 
00T00630 
DOT00640 
OOT 00650 
OOT00660 
DOT00670 
OOT00680 
DOT00690 
OOT00700 
OOT00710 
DOT00720 
OUT00730 
DOT00740 
UOT007S0 
DOT00760 
DOT00770 
OOT00780 
DOT00790 


■nr^n 


FILCJ  DOTS 


C 

i 


PEAD  A SCAN  LTNE  OF  DATA,  AND  PPOCESS  IT 

no  sgo  line«linstr*lineno«lininc 

NLINE  ■ NlInE  ♦ I 

CALL  LlNEHO«tOATA*ENDTAP) 

IF  TENOTAP  .ECi.  -1)  GO  TO  600 

FIND  intersections  fOR  N-R  FIELDS 

CALL  FDLINT(VERTEXdPT)  •FIELDS(4»N0FL02)fFLfLlNEf  SAMP«NI> 

no  400  J>1*NT«? 

■ »-SAM« 

>4M<;TR) /SAMINC  * 1 

.(J)tSAMlNC))  IB  ■ IB  « 1 


DOTOOHOO 

pOTOOeiO 

OOTOOB20 

yoTQOHsg 

DOT00840 

OOT008S0 

DOT00860 

DOT00870 


OOT0089 


0010090^ 
nOT009?0 


DOT009) 


no  4P0 

IB  ■ (FL(J»-SAMSTR)/SAM1NC  ♦ 1 
IE  • (Fl(J*D-  SAMSTR)/SAMINC  ♦ 1 
IF  (MOn(SAMSTR*SAMlNC)  .NE*  NOD(FL( 


(IB  .GT.  IE)  60  TO  400 


COLLECTING  INFO  FOR  DATA  REC  FOR  DOTFIL 


C 

C 


DO  350  K>I8«IE 


OOT00930 
OOT0O94g 
OOT009S0 
DOT00960 
OOT00970 
DOT00980 
OOT00990 
OOTOIOOO 
ooToioio 
020 


TOTVEC  « TOTVEC  ♦ 1 
IFlTOTVEC.LE.aSO)  60  TO  110 
TOTVEC-250 


lOA 

109 

no 


WRITE(6f lOB) 
)PHAT 


030 
040 
OSO 
O63 


format ( ////) 

FORmW^?^??’*****  note  - TOTVEC  WAS  GREATER  THAN  250«  THEREFORE 
IVFC  WAS  SET  TO  250  •••••) 

(5(5  TO  600 


rONTINUF 
OATAd  .TOTVFC) 
DATA(?. TOTVEC) 


« SAhSTR  ♦ SAMINC  • (K-1) 


IRO 

3S0 


DATA(3«TpTVEC) 

0ATA(4. TOTVEC)  » NOCAT 
no  150  1*1.imOFET2 
KK  ■ (1-1)*NSAWP  ♦ K 
0ATA(4*I, TOTVEC)  « lOATA(KK) 
CONTINUE 


400  CONTINUE 


SOO 

600 


C 


CONTINUE 
CONTINUE 
GO  TO  85 

WRITE  DOT  DATA  FILE 


510  CALL  WOTFL0(FIFLDStVERTE*,N0FLn2.2tCATNAM,0UMMY) 

CALL  WPTDOT ( TOT VEC.NfSUN.riELOS* VERTEX. SUN ANG.OATAtNOC AT t 
C4TNAM.$IZE.N0FEt2»FETVC2.T0TVT2»N0FL02. 


1 


• OOTUNT.OOTFIL) 
nOTFIL  « POTFIL  ♦ 

NOCAT  = 0 
SWTCH  » 1 
IF(LACIE.nE.0)N0FLD2*0 
lF(NT*<Cr.€Q.l)GO  TO  530 
GO  TO  90 

SEND  CARO  FOUND 

5?0  CALL  wPTFL0(FIFL0S.VERTEX,NOFL02.2.CATNAM,DUMMV) 

CALL  wMTOOT (TOTvEC.NOSUN. FIELDS. VERTEX. SUNANG.OATA.NOCAT. 

• CATNam,sizE.N0FET2,FETVC2.T0TVT2.N0FL02  ♦ 

• OOTUNT.OOTFIL) 

SWTCH  « 0 

IF(PRTEEy,F0.1)60  to  530 

ROUTINE  TO  PRINT  DOT  DATA  RECORD 

510  CONTINUE 
700  format (//) 

600  format ( IX. • N0,*.2X. •SAMRLF».2X. 'LINE ».2X. ‘TYPE *.2X. ‘CATEGORY ♦( 


OOTO 
GOTO 
OOTO 
OOTO 

B0TOI07. 

POTOiOBO 
OOT01090 

ooTonoo 
TOTDOTOlilO 
OOT01120 
OOTOI130 
OOTOilAO 
00101150 
OOT01160 
OOT01170 
OOTOllBO 
OOTO 1190 
DOT01200 
DOT01210 
OOT01220 
OOT0123O 
OOT01240 
OOT01250 
DOT01260 
OOT01270 
(JOT012B0 
DOT01290 
0OT0J300 
DOT01310 
DOT01320 
OOT01330 
OOT01340 
nOT01350 
DOT0i360 
OOTOl 370 
OOT013BO 
0OT01390 
UOT01400 
POTOUIO 
DOT014P0 
DOT01430 
DOT01440 
DOT014S0 
DOT01‘*60 
DOI01470 
DOT01400 
liOl  01490 
00701500 
OOT01510 
OOT01520 
OOT01530 
l)OT01b40 
0OT01550 
POT01560 
UOT01S70 
» DOT015B0 


5Jy 


FlLri  DOTS 


1 30X**OlkTA»/) 

T»RT«1 


709 


7>0 

710 

71? 

800 


830 


8«0 


,NOFET?>  l|Np»t»iOF|T2 

'9“''**'"!  i?'a*TO  >2. 


6*810) 


^5S9iA8e 

IKT«0 

6o.8oo.ii*i*totvec 

TKT«!KT*1 

}F(I|n0.6T,? 

0RH*T(lHi,5(/)| 

TFIIKT.nE.I)  60  TO 
WRTTF<o.700) 

WRITF<6.6Q0) 

WRTTFCO.TZO) <flL8NK.FETVC2(l) .1«1START.1EN0) 

FORMAT (37X*10(Al, *CMl •*I2* •) •)) 
rONTINlJE 

wRTTE(6«7lg>Il«(0ATA(I*lI)*Ial«A)t(0ATA(««JJ*II)*JjBlSTART*IEN0) 
format ( IX ti3tlH.*3X«l4«3X*lA«2X*12*6X*I2*6X* lot I3*4X) ) 
WRTTE(6»712)  . ..* 

format ( ) 

CONTINUE  - . 

TF(N0FFt2.6T.10)  60  TO  830 

00  TO  840  - . . • ^ 

CONTINUE 

IFllTWO.EQ.l)  GO  TO  840  . 

TTW0«1 

ISTARt«I|ND*I5TART 
IEN0»N0FET2 
r-O  TO  700 
CONTINUE 

TF  (SWTCH  ,F8.  1)  60  TO  90 
return 

END  ... 


DOTQ 

OOTO 

DOTO 

OOTO, 

pOTOl 

Bol 

OOTOl 

691®* 

OOTO, 

pOTOi 

OOTo! 

DOTO 


OOTO 

bOTO 


JOT 
DOT  . 
OOTO) 
OOTO 
OOTO 
OOTO 

gOTO 
01 0 


DOTO 

BOTO 
OTO, 
DOT  01 
OpTo! 
OOTO) 


# * I 

i! 


tile:  FLDLAC 


Ficins  - CA!EOp»y.NAME, 
STAHNT  - 


NT  - IniV2|1lV*SEt'^0  II"Si»ItMCEO  to  1' 
TAKEN  EhOM  CUNRKNTCv  HEAO.CAHO* 

fyois.iiBsRWoi« 


DOT  TYPE  FOR  DOT 
ELOUii 


IPT 
VERTEX 


I STORED  IN 
INDICATE  DOTS  BEINO 
Field  vertex  information! 


.OS • ST AMNT t •***•» I PT » VERTEX » 


»LCATNM(4> 


C 

C 


SUBPQUTINF  FLDLaCJFIELC 
IMPLICIT  INTEGER  «A-ZT 
LOGICAL*!  LCARf)(3flO»  »l 

OiMkNSTON  FIFLOSU.  1 ) oVERTEX ( 1 ) *CAR0|7S)  tNOOTS  130) 

OTMFnSTON  aCARU(80> 

C-!iifcH/^TRUE./»SwCMG/0/»CNOBCO/»»EN*/t 
/•  •/ 

CHBKI4 


CSENO 


• GRPCHK («i) tGROUPSClZM) 

COMMON  /OOTVEC/TYPEoCATNAHlftO) ♦NOCAT.TOTVEC.FLOINF (6) tPRTKEV 

• *SIZE  oLACIE 


) «CATNH) , CLCARO(l) *0X00(1) ) 
0 
0 


liol) <«CAHn(I) tlaltSO) 
FOWMAKMOAI)  ......  ... 

write  (30o  103)  (ACAWOd)  *I«1«80) 
REWIND  30 

H5ADOn.inoO)  I0«TYPES*CAR0 
R^-lMD  30 
“ >3.1 


1000  FORMAT (Aj 
IF(TYPF.FO 
IF (SwCHL.w 
TYPE  * 1YP 


.TYPES  )60 


i 

c* 


.0)00 

:s 


TO  20 
TO  4U 


PEAO  CARO 


NAME*  CORRECT  COL  COUNT  TO  READ  NUM 


C 

C 

C. 

i' 


COL  ■ n 

CATNM  ■ NkTCHR(CARO»COL) 

IF  NEXT  CHAR  IS  NOT  A CAT. 

1F(CATM^<,^,T,0)G0  10  21 
LiNnfX*A*C0L*l 
LCATNM(2j  «LCARD(LIN0EX) 

COL*COL*  > 

IF(CATNM,F0.CATNH1)60  to  23 
NOCATwMOCaT  ♦ i 
CATNAM (NOCAT) *CATNH 
CATNMl  ■ CATNM 
r*o  TO  ?3  . 

C0L»C0L  - 1 
NnCARDsO 

CALL  NUMRW (NOOTS.NOCARD.CARO.COL) 

iF(NOCARD,EO.O)GO  TO  10 
CNT  ■ 0 
TAmNT  ■ 7 
SWITCH  « .true. 

(.0  TO  100 

TEST  FOR  FNf)  OF  DOTS  TO  RE  PROCESSED  ON  CA«0 


30  if(icnt.lt.ndcaro)60  to  IOO 
READ  NEXT  CAPO 
|TAMNT  ■ 1 

i?An<?i?ini) <ACARrMi).i«i»80) 
WRITE (70 .103) (ACAWD( I) *I«1«90) 
REWIND  30 

HFaOOO.IOOO  ) ID. types. CARO 
rewind  30 

lF(ID.ro.FNI)MCl))«ETUMN  3 
|F(TYPE.ED.1YP£S)G0  TO  20 


ill 

FLOO( 

fldoo 

FLOOO 

flood 

FLOOO 


FLt , 

FLOOOSAj 
fj.jjJ.5S, 


FLOOOA3C 

FLOOOA4C 

FLOOOASi 

FLOOOAOe 

FL000470 

FLOOON8Q 

FLO00A90 

fldoosoo 

FL000510 

FLD00520 

flooo|5o 

FLO005R0 

FLUOOSSO 

FLO00560 

FLU00570 

FLO00S80 

FLD00S90 


FLD00630 
FLOUODRO 
FLO00650 
FL'>O0D#»0 
FLD00N70 
FLO00H80 
f LOOOHVO 
FLO00700 
FL000710 
FLO00720 
FL000730 
FL000740 
FLO007S0 
FL000760 
FL000770 
FL000780 
FLD00790 


no 


MLCi  PLDLAC 


C 

8 


35 


SWITCH  * .false. 
SWCHG  ■ .S*^Ch6  * I 


100 


NN 

H 


>AN6E0  JUNE  197S 
RETURN  a 

ICNT  ■ ICNT  ♦ 1 
NOFL02  ■ NnFLOZ  ♦ 1 

COMPUTE  LINE  increment 

■ NflOTsnCNT) 

>IAPS(  NM)  / 100000000 
• I*HS(NN)  • nI  • 100000000 

(L1.6C«)00000000)N1  ■ Nl  «1 

COMPUTE  Sample  increment 

KK*1 

IF(NN.LT.0>KK»-1 
LI  « NI  • KK 

■ NN  - LI  * lOOOOOOOO 

■ 1AHS<  N2>/10000 
« IAHS(NV)-Nl  • IftOOO 

. (Sl.GF.1C0r.»N3  ■ N3  ♦ 1 
FK»1 

IF<N2.LT ,0)KK»-1 
51  ■ NT  •KK 
LACl  ■ NP  - SI  • 

LR  « (L4CI-1>/19 
LP  ■ (LP*i)  • 10 

LS  ■ LR  - 1 

l|  ■ LS  /lO 

LS  » 10  ♦ (LACI 

C » Lfi  -LI 
5 » LS  ♦ SI 

STORE  nOT  INFO 


10000 


(LS*19n 


FiELnsd.NOFLn: 

fIelds(<.,nofldJ 


flo^nfuj 

FLUINF(P)  ■ 
FLDlNFO)  ■ 

- ^ NF(4)  ■ 
NF(5)  ■ 
NFCftI  ■ 
PT.nE.O) 

• -3 

IPT  ♦ A 
■PT) 


|ATNH 


f 8 

PT 

PT 


0 TO  35 


VFPTFX< 

VFPTFX( 

VERTEX ( 

VERTEX ( 

return  1 

AO  R!»ITF(A.2f>00) 

2000  FORMAT  (//‘iX. ‘ERROa 
•D|  - SUBROUTINE 
return  3 
END 


FLOOOOC 

FLOOOR] 


mm 

FLO0093 


[bill! 


E88I 


«5-., 

fW  .. 

fldoIIao 


, MAS  occurred  in  heading 
Elulac  - Exit  taken'T 


LACIE  FORMATTED  DOT 


r ww  . 

FLDO 

FLOO 

FLDO 

FLOO 

FLOO 

FLOO 

FLDO 

FLOO 

FLOO 

FLDO 

FLDO 

FLOO 

FLOO 

FLDO 

FLOO 

CARFLDO 

FLOO 

FLOO 

FLDO 


ftnTY^ 


l{LOS*tTAMNTt*»**«»lPT«VCIITCXI 


JtCNO 





^TOTVCCtfLOIMFUl  tWlTHfV 


•0 


•0 


VCHTCX f I^TI .rLOINT I 1 I ,r ICLOS ( 4 , NOTLO^i 

WAS  CLASSfSUtCLASStFICLOt  OR  tCNO*  (MroUNTEMEO 

liiiiHiM 

TYPE  CARO 

60  TO  100 


•SWITCH) 

4HNT  • 2 
,_TURN  2 

Rf*or 
forma . 
rewind 

0 

TCRO  ■ 0 

M«  NUHPE«(CARO.COL. TYPE. ZERO) 


1 


u: 


130 


ss'tV,; 

CL4SSNAME  CARD 

format (1  OX 
NOCAT  ■ N 
OEAOOOtl 

sSms^.s* 

FIELD  CARO 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


*S5{St' 

• U0)CA 


♦ 1 

)CATNAH(NOCAT) 


1 


. Noruj  . 

return  1 

SEND* 

switch., TRUE. 

return  3 

ENO 


I 


!ao 

iSi 


I 


ftgSJll 

FL0006T 


3J>t 


riLCt  SCT)3 


M«2)  «E0UC0MI3)  *ACAf»OI2f  I 


>TF*« 

l*f*He02*f**CN0*/ 


^U«I»0UT1I»|  5f?13 
I*«»LKlt  InTFWh  (A-n 

OI**£NSfON  cnnf  (•»  jCAftOI 

n|wfN$lO*)  SLASH I2l 
ftJkTA  SLASH 

Data  •/#u/»u*/*ff/*f*/*oo/»o»/*f/*f#/ 

DATA  L/»L»/ 

INCLUDE  C0NflA6*LIST 

i85J»i}S5ig?85A)ftWfj 


• qhpchkI 
dimension  hEDH15)«hE 
EOUI valence  ( ’ED 

^COMMON/GLOBaL/hD 

• HI 


K^PpfSIAS!  t 


mfiLE* 


• noiiH*D»nMMt<6S.NAG5l2*0ATFlL 

• *NHSTlJN»NHSTf  1,SCTHUN.MAPFIL  _ 

• .OOTUiiT.OOTFTLiNCHP*SfTRNSFL**HTI»rL*Ml5TrL#FCMUMT* 

• rPDUNT.PHTUNT.HANOlO  MTMW 

common  /OOTvEC/TypE  tC aTNAM(NO) *NOCATf TOTVtCfFCOUV (B» ♦PRTREV 

.SIZE  * LACIE 


CSENO 


ZE»0  « 0 
NOFET2  ■ 0 

pifKEV  ■ i 

NPUT«S 
LACIE  • 0 

MRITE(N.inO) 

100  FORMAT (/II*. 'INPUT  SUMMARY'//! 

SET  UP  REREAD  BUFFER 

PRIJNIT  c 30 

CALL  REREa5(RRUNIT*80) 

PUT  CARO  IN  BUFFER 

}A^  PfAD(?1  .inSMACAHDd)  tlB|«20> 
l«3  FDOhaT(POAa)  . . . 

mRITEOO.IO'A)  (ACAPO(1)«Ib1«20) 

REWIND  WRUNIT 

RFAD(3n,nO)COOEl*CARD 
rFwino  RRUNIT 

SpVTFCA.lZDCDnErfCARO 
IPO  format (lX*A4«AAf62An 
110  format (AA*6X*APA1  ) 

IF  icODF|!^*/!^COOE(l) ) GO  TO  IISS'JSS’JIa* 

• 390*400t AIOaAcOi t 1 

iRO  continue 

4A  FORMatV'*1nvalIO  control  CARO  - IGNORED  •> 
fiO  TO  lOS 

CHANNEL  CARD 

lM(t  M > NxTCHR  (CARO«COLt 
TF  GD  TO 

IF  (M.Fij.aLNR)  GO  TO  105 
IMF  WH1TF(n.1S3»  ^ . 

1^^  format ('  ERROR  ON  DATA  CAPO') 

GO  TO  105 

IMM  .1  B FINOl  ?(rAHn.COLtfOUCOM) 

IF  (.)  .Nf.  ?l  GO  TO  15?  , 

NOFET?  B NUMHf R(CAROiC5l»FETVC?»NOFCT2I 


L T V VW^ 

imi 


ET0034( 
0 

» fOv 
SETOO 
SCTOO--- 
,T00590 
^TOOAOO 
^TOOAIO 

^TOOAAO 
JTOOA50 
iETOOAGO 

mtu 

fTOOAOO 

.Ktoosoo 


^TOollo 

^TOOSaO 
^ZTOOSSO 
SET0Q560 
TTOOfTO 
■TOOSOO 
^TOOSRO 
[T00600 
tTQOblO 

t_iT006?0 
IT00630 
ET006AO 
-TT00650 
^TOOGGO 
hOOGTO 
tTOOGPO 
[TOOGVO 
•T06700 

HSSUI 

SFT00730 
SET007A0 
SET00750 
SETO07G0 
S1TO0770 
SET007G0 
SET00790 


3’^ 


FlLEt  5ET13 


CALL  ORDER (FETVC2.N0FET2) 

RC  TO  105 
C 

g DATA  FILE  CARD 

lAO  M c NXTC^^R(CARO«COL) 

IF  (M  ,FC,  OLNK  > 60  TO  105 
TF  (M.FQ.OI  RO  TO  IRO 

TF  (►‘.EO.FF)  60  TO  200  

1A5  WPTTE(ft«l87) 

1A7  F0OMAT(*  ERROR  ON  OaTa  FIlE  CAR0»» 

GO  TO  105 

loo  J « FlN012{CAPn,C0L»EQUC0M) 

IF  (J  .NE.  GC  TO  185 
H « NUMBER  CRD. COL»DATAPEtZERO) 

COL  » COL  - 

60  TO  180  - 

200  J » FIND12(CAR),tOL*EOUCOM» 

TF  ( J .NE.  ? ) GO  TO  185  ^ 

M s NUMBER<r.APOtCOLtOATFlL*ZERO»  ■ - - 

OATFIL  = OATFIL  - 1 
rOL  = COL  - 1 ■ 

GO  TO  180 

C DOT  FILE  CARD  ' _ . . . 

C 

2T0  M = NXTCHR (CARO.COL) 

IF  (M.FO.OO)  60  TO  213- 

TF  (M.F0.6LNK)  GO  TO  105  nDT^^r^r. 

GO  TO  215  ORIGINAL  PAGF’ 

213  J = FIN012(CARD«C0L. SLASH) 

IF  (J  .EG.  -1)  GO  TO  215  Oi-  POOR  QUALITY 

214  M * NXTCHHtCARO.COL)  ^ 

IF  (M  ,FQ,  RLNX  ) 60  TO  105 

IF  (M.FO.U)  GO  TO  230 
IF  (m.EC.FF)  go  to  240 
2)8  WBTTF(8.220) 

220  format (•  ERROR  ON  DOT  FILE  CARO') 

GO  TO  1 05  . « . 

230  J = FIND12<CARO»COL»EOUCOM) 

IF  ( J .NE.  2)  60  TO  215  

M = NUMhEW (CARD.COL.DOTUNTtZERO) 

COL  s COL  - 1 
RO  TO  214 

240  .1  * F1ND12(CARO,COL«EOUCOM) 

IF  (J  .NE.  2)  GO  TO  215 
M = number (CaRO»COL»DOTFIL»ZERO) 

nniFiL  = dotfil  - l 

rOL  = COL  - 1 . ..  

GO  TO  214 
C 

g OPTION  CARO 

330  M s NXTCHR(CARD.COL) 

TF  (M  .ro,  alnK  ) GO  TO  105 
TF  (M.FJ.P)  60  TO  340 
IF(M,EO.L)GO  TO  345 

C*#*  CODE  added  NOV  21.  1978  IN  SUPPORT  OF  LIST  PROCESSING 
C 

IF  (M.EO.U)  60  TO  350 
C 

333  WOTTE(N.335> 

335  FORMAT (»  ERROR  ON  OPTION  CARO*) 

GO  TO  105 
340  PRTKFY  s 1 
GO  TO  105 
345  L4CIE  = 1 
GO  TO  105 

350  M = number (CARD. COL.LACIEf ZERO) 

. GO  TO  105 

C 

C date  CARO 

*■  370  M s NXTCHR(CARO.COL) 

TF  ( M .EU.  PLNK  ) 60  TO  105 
oFA0(30.3m0I(iatE 
380  FOHMaT ( lox. 15A4) 

REWIND  RRtlNlT 


nn  n or>r>  nc^n  orv> 


FILPl  SET13 


RO  TO  105 

COMMENT  CARO 

390  M s NXTCHR(CAR0*C0L) 

IF  IM  ,EQ.  RLNK  ) 60  TO  105 
OFAD(30.3H0)C0MENT 
REWIND  RHUNIT 
60  TO  105 


HEOl 

400  M = NXTCHB (CARO. COL) 
READ(30.3»0>  HEOl 
rewind  RRUNIT 
60  TO  105 

. HE02 

410  M « NXTCHR(CARO.COL) 
REaOOO.SHO)  ME02 
REWIND  PROMT 
60  TO  105  I 


•END* 

420  rONTINUF 

IF  (NOFET2  ,NE. 
no  430  T=1.30 
FETVC?(I)  » I 
430  CONTINUE 
N0FET2  -I 


0)  60  TO  440 


440  6I7E  s 4 ♦ N0FET2 
WRITE  (f>.  1000)  ■ 

!F  (N0FET2  .NE.  0)  WRITE <6. 1010)  (FETVC2 ( I ) ♦ I»1 .N0FET2) 

IF  (PPTKEY  ,F0.  1)  WHITE (6.1030) 

1040  FORMAT (•  LACIE  FORMATTED  DOT  CARDS  USED  AS  EOD-LARSYS  FIELD 
: ) 

IF (L AC  It. EO. 1 ) WRITE (6. 1040) 

1000  FORMAT)//'  USER  HAS  RFOUESTED  THE  FOLLOWING  OPTIONS  S'/) 
1010  FORMATC  SELECTED  CHANNELS  AHE'.30I3) 
lO-^O  FORMATC  PRINT  DATA  VECTORS') 

RETURN 

end  i 


SET01590 

SET01600 

SET01610 

SET01640 
SET01650 
SET01660 
SET01670 
SET01680 
SET01690 
SET01700 
SET01710 
SET01720 
SET01730 
SET01740 
SET01750 
SET01760 
SET01770 
SET01780 
. SET01790 

SET01800 
SET01810 
SET01820 
SET01830 
SET01B40 
SET01850 
SET01860 
SET0I870 
SET01880 
SET01890 
SET01900 
SET01910 
SET01920 
SET01930 
SET 01940 
SET01950 
SET01960 
SET01970 
CARDS'SET01980 
SET01990 
SET02000 
SET02010 
SET02020 
SET02030 
SET02040 
SET02050 
SET02060 
5ET02070 


18.  LABEL  PROCESSOR 


FILE  LABEL 


C 


SUBROUTINE  LABEL (ARRAY*TOP) 

IMPLICIT  INTEGER  <A-Z) 

DIMENSION  FLOSAV<2000)  tARRAYd) 

60  READ  CONTROL  CAROS 

CALL  SETU(ARRAY.TOP#EXIT> 

READ  IN  REQUIRED  FILES 

CALL  FILERO(ARRAY«TOP*NOFLO*TOTVRTtFLOSAVm  »FLDSAV(1001>  ) 
READY  TO  perform  USER  REQUESTS 

CALL  LABLR (ARRAY. TOPtNOFLO* TOTVRTfFLOSAV ( 1 ) tFLOSAV ( 1001 ) • 

* FLDSAV(l) .EXIT) 

FINISHED  — SEND*  CARO 

REAO(?l*100)CARO 
100  F0RMAT(A4) 

RETURN 

END 


LABOOOlO 

LAB00020 

LAB00030 

LA9000AO 

LABOOOSO 

LAB00060 

LAB00070 

LABOOORO 

LABOOOOO 

LABOOlOO 

LABOOliO 

LAB00120 

LAB00130 

LAB00140 

LA8001S0 

LAB00160 

LAB00170 

LA600180 

LAB00190 

LAB00200 

LAB00210 

LAB00?20 

LAB00230 

LAB00240 


ORlGlSWi^ 
OF  Fool; 


PAOF  is 
qfmjty 


3 5-?^ 


FILE  ALLKIN 


SUBROUT INC  ALLK 1 N ( DOTS  * SUB VEC • SUBNO • C AT VEC  t MEANS  » OOTSUM ) 
LABELS  BY  ALL-OF-A-KIND  PROCEDURE 
IMPLICIT  INTEGER  (A>ZI 


INCLUDE 

INCLUDE 

|nclude 


C0MBK1«LIS1 

comrka.LIS] 

CMRK15.LIS1 


CSENO 


__  C0HRK6«LIST 

N/1NF0RM/N0CLS2.N0SUB2.N0FET2*VAPSZ2.T0TVT2»N0FL02» 

• Ay5R?»COVAR2fCLSlD2.SUBN02»SUBDS2tFLOSV2#VERTX2# 

• FETVC2<30) .SUBVC2«75»  fSU0PTR(75) tCLSVCZiGO)* 

• KEPPTS(60>  *N06RP«6RPNAM(60> •6RP0EXT61) » 

• 6RPCHK (61) .GROUPS (124) 

DIMENSION  HEOl (IS) *HE02(15) .DATE (3) .COMENT(IS) 

EQUIVALENCE  (HEOl ( 1 ) .HEAD (4) ) . (DATE ( 1) .HEAD122) ) • 

^<HEQ2(i).HEA0(30)).ICOMENT(l).HEA0(4Bn 
COMMON  /LABS/NOCAT.CATNAM(60) .NOCL2.CLSNM2(60) .N0CAT2.CATNM2(60) • 
SUBRAY (120) .PTR(60) .CATPTR(250) .CATOOT(SOO) • 
OOTWEC(|50) .COND.MlX.PROC.^ArKEY.OOTKEV.STATKV. 
SUNANG.T.NEARST.DTST. NOFEAT. FETVEC(:,0!  , iVAPUN.OMAPFI  . 
OSAVTP.OSTAFI.NOSUN.ANGLE(B) .SIZE.tOTOT2.FLDlNF(6) * 

CLSSYM(62) «STA0RS.MEANA0.TABAnH.MAPADR.SUNC0R(30)  « 
ODOTUN.OOOTFI.MANSTA.MANOOT.DSPUNT.OSPFIL.OSPKEY.PRNSTS. 
PRNDOT.FLUNAH, VERTEX (22) .NOVRT .NSUN. ANGLES <8) 
.TOTOT3.FLOADR.VTXADR 

COMMON/GLO8AL/HEA0(63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEY. 

hisfr.hiskey.trform.eriptp.erpkey.mapunt.nofile. 

ORUMAO.DRMWOS.PAGSIZ.DATFIL.STAFIL.ASAV.ASAVFL 

.NHSTUN.NHSTFI.SCTRUN.MAPFIL 

.DOTUNT.DOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

CRDUNT.PRTUNT.RANDIO 

DIMENSION  D0TS(SIZF.T0T0T2) .SUBVEC ( 1 ) .SUBNO ( 1 ) .CATVEC (1) » 
CAT6RY(6n  ) .CLSTN0(250) . . OOTNUM(2SO). 

D1STNC(2S0) 

DIMENSION  MEANS (N0FET2.1) 

DIMENSION  TIES(2S0) .DOTSUM(6O.60) 

RETRIEVE  CLUSTER  CLASSIFICATION  FOR  EACH  DOT 


N5AMP 

LINES 


s (FL0INF(5)-FLDINF(4))/FLDINF(6)  ■ 
=(FLDINF(2)  - FL0INF(2) )/FLDINF(3) 


1 

♦ 1 


DO  100  I=1.T0T0T2 
ILINE  = D0TS(2.i) 
ISAMP  = OOTSd.f) 

PIXADR  a orumad  ♦ 
CALL  ■■ 


(ILINE-1)*NSAMP  ♦ ISAMP-l 
RRE AD ( P I X ADR .NUMBER . ! . 1ST AT ) 


CLSTNO  — CONTAINS  THE  CLUSTER  NO,  OF  EACH  DOT 


90 

100 


IF  (ISTAT 
CLSTNO(I) 


.EO.  1)  GO  TO  90 
S NUMBER 


111 

nil 

1000 


155 


WRITE(6.HEA0)  ' 

VRITE(6.111) 

format (TSO. 'LABELING  BY  ALL-OF-A-KINO  PROCEOUREO 
VRITE(6.1111) 

FORMAT (20X, 'CLUSTER  LABELING  DETAILS*./) 

WR1TE(6.1000) 

FORMAT  (3X.  'CLUSTER*  .2X.  'CLUSTER*  .3X.  'DOT*  .i»X.  'DOT*  . 

1 7X,  'DOT*  .<iX.  'DOT*  ,/.3X,  'NUMBER '.  4X  . 'LABEL  *.  3X.  'LABEL*. 

2 2X. 'NUMBER*. 2X. 'DISTANCE*. 2X. 'CLUSTER'.//) 

major  do  LOOP 

DO  300  lal.NOSUBZ 

REINITIALIZE 

DO  155  J=l. NOCAT 
CATGRY(J)  s 0 
MAX  s 0 
NODOT  = 0 
TIE  a 0 


ALLOOOlO 

ALL00020 

alloSoaS 

ALL00050 

ittSSifl 

ALL00080 

ALL00090 

ALLQOIOO 

ALLOOilO 

ALL00120 

ALLOOlSO 

ALLOOUO 

ALLOOiSO 

ALL00160 

sttssr 

ALLOOj 
ALLOO. 
ALLOOl 
ALLOOl 
ALLOOl 
ALL00240 
ALL00250 
ALL00260 
ALL00270 
ALL00280 
ALL00290 
ALL00300 
ALL00310 
ALL00320 
ALL00330 
ALL00340 
ALL00350 
ALL00360 
ALL00370 
ALL00380 
ALL00390 
ALL00400 
ALL00410 
ALL00420 
ALL00430 
ALL00440 
ALL00450 
ALL004S0 
ALL00470 
ALL00480 
ALL00490 
ALL00500 
ALL00510 
ALL00520 
ALL00530 
ALL00540 
ALL00550 
ALL00560 
ALL00S70 
ALL00580 
ALL00590 
ALL00600 
ALL00610 
ALL00620 
ALL00630 
ALL00640 
ALL00650 
ALL00660 
ALL00670 
ALL00680 
ALL00690 
ALL00700 
ALLO0710 
ALL00720 
ALL00730 
ALL00740 
ALL00750 
ALL00760 


333 


FILE  ALLKIN 


i 

i 


FIND  ALL  DOTS  IN  CLUSTER  I 

DO  ISO  J-1.T0T0T2 

(CLSTNO(J> .NE.  I)  60  TO  ISO 
K ® OOTSCAfU) 

CATGRY<K»  ■ CATGRTIK)  ♦ I 
NODOT  • NOnOT  ♦ 1 
OOTNUM (NODOT)  ■ J 
150  CONTINUE 

WERE  DOTS  - 1 OF  A KINO 
WERE  DOTS-  HEXED 
WERE  DOTS—  NULL  SET 
DO  160  J*l. NOCAT 

IF  (CATGRY(J)  ,LT.  MAX)  60  TO  160 
MAX  3 CATGRY(J) 

CATNUM  > J 
160  CONTINUE 

IF  (MAX  .NE.  0)  GO  TO  170 
DEFAULT  TO  K-NFARtST  NEIGHBOR 


C 

c 


c 

i 

C 

c 


}ab?  • }abadr  ♦ 

SWTCH  » 1 


(I-l)*TOTDT2 


I 

lllo 


WRITE(6.165) I 

165  format (//t3X«t*»  DEFAULTING  TO  K-NEAREST  NEIGHBOR  PROCEDURE  FOR 
1USTF.R  ••*»T5) 

CALL  KNEAR(DOTS*OUH»DUH.CATVECtITERtTABl*SWTCH«CATNUM«IfHEANSt 
I OOTSUM) 

GO  TO  300 

LABEL  BY  MAJORITY 

170  CONTINUE 

PRINT  CLUSTER  INFORMATION 

TABl  a TABADR  ♦ (I-l)*TOTDT2 

CALL  RREAD(TABl»OIStNCf  r0T0T2tlSTAT) 

GO  TO  CODE  FOR  A TIE 

GO  TO  390 

WRITE  bOT  DETAILS 

WRITE(6«1100> I«CATNAM(CATNUH) 

FORMAT (/tSX, I 2,flXflAA) 

00  no  Jal.NOOOT 
DSTsDOTNUM(J) 

KsOOTS(4tOST) 

IF(J.E0.1>wRITE(6«1201)CATNAM(K) tOOTVEC(OST) »OISTNC(OST) * 

1 CLSTNO(DST) 

FORMAT (lH*fT24. 1A4.2X,I3,AX,F7,2.AX.I2) 

IF(J.GT.1)WRITE(6«1200)CATNAM(K) *DOtvEC(OST) tOISTNC (DST) • 

1 CLSTNO(DST) 

FORMAT (23X,lA*t2X,I3,AX*F7.2*AX«I2) 

OOTSUM ( I.K) aOOTSUM ( I.K) ♦! 

CONTINUE 


1201 

1200 

^10 

C 


IF  (TIE  .EQ.  Oi  GO  TO  300 


WRITE(6.211) 

211  F0HMaT(23X,*A  tie  OCCURRED. 

• I*/) 


THE  FOLLOWING  OOT(S)  WERE  OISCAROEO 


00  213  Jal.TlE 
INOEXl  a TIES(J) 

LARFlS  a OOTS(A. INOEXl) 

213  WRITE(6.1200)CATNAM(LABELS) .OOTVEC ( INOEXl ) .DlSTNC ( INOEXl ) • 


ALL00770 
ALL007B0 
ALL007R0 
ALLOOeOO 
ALLOOBIO 
ALL00B20 
ALL00830 
ALL00840 
ALL00860 
ALLOOB60 
ALL00870 
ALL00880 
ALL00B9O 
ALL00900 
ALL00910 
ALL00920 
ALL00930 
ALL00940 
ALL00950 
ALLOO960 
ALL00970 
ALL009B0 
ALL00990 
ALLOIOOO 
ALLOIOIO 
ALL01020 
ALL01030 
ALL01040 
ALLOIOSO 
ALL01060 
CLALL01070 
ALL01080 
ALL01090 
ALLOllOO 
ALLOlllO 
ALL01120 
ALL01130 
ALL01140 
ALLOllSO 
ALL01160 
ALL01170 
ALLOllSO 
ALL01190 
ALL01200 
ALL01210 
ALL01220 
ALL01230 
ALL01240 
ALL012SO 
ALL01260 
ALL01270 
ALL01280 
ALL01290 
ALL01300 
ALL013I0 
ALL01320 
ALL01330 
ALL01340 
ALL013S0 
ALL01360 
ALL01370 
ALL01380 
ALL01390 
ALL01400 
ALLOUIO 
ALL01420 
ALL01430 
ALL01440 
AILOUSO 
ALL01460 
ALL01470 
ALL01480 
ALL01490 
ALLOISOO 
ALLOISIO 
ALL01520 


FILE  ALLKIN 


1 CLSTNO(INOEXl) 


300  CONTINUE 


WRITE  DOT  SUMMARY 


ALL01530 

ALL01S40 

ALL0I5S0 

ALL01560 


2222 

1300 


WRITE(6t2222) 

format (1H1,20X» 'CLUSTER  LABELING  SUMMARY**/) 

WPITF (6* 1300) 

FQBMAT13X* 'CLUSTER*. 20X* 'NUMBER  OF  DOTS  USED  (BY  CATEGORY 


ISTRTsl 
^=NOCAT 


130S 

1330 

1310 


IENO=  

IFdEND.GT.lS)  lENOslS 
WHITE(6.1305) 
format (3X. 'NUMBER*. 3X. *LABEL ' .7X.S0 ( 1H*> ) 
WRITE(6.1330) 


format (1h*»T20. 'TOTAL') 
W5IIE<P»i310) (CATNAM(IJ) .!J«1.IEN0) 


format  <30X,1A4.U(3X.IA4)) 
D0_600  I»l»NOSU82 


550 


TOTAL«0 
00,550, J*1. NOCAT 
TOTALsTOTAL*OOTSUM(I.J) 
K*CATVEC(I) 


1320 

600 


WRITE16.1320) I*CATNAM(K) tTOTAL.(OOTSUM(I*J) *J«l*IENO) 
FQRMAT(//.5X.I2.6X.1A4.15.2X.1S(2X.I5)) 


602 


1350 


CONTINUE 
IF(IEN0.E0.N0CAT)60  TO  650 
ISTRTsIENf)*! 

IENO=NOCAT 

IF(IEND.GT.1STRT*14)  IEND«ISTRT*U 
WRITF(6.1350) 

FORMAT!//) 


t»RITE(6.1300) 
WR|TF(6.1305) 


1340 

610 


WRITE (6. 1310) (CATNAM(IJ) .IJsISTRT.lENO) 

DO  610  1=1. ITER 
KsCATVECd) 

WRITE (6.1340) I. CATNAM(K) . (OOTSUM(I.J) * J=ISTRT* lENO) 
F0RMAT<//»5X.I2.6X.1A4.7X.15(2X.I5) ) 

CONTINUE 
60  TO  602 


GROUP  LABELED  CLUSTERS 


150 


310 


K « 0 

DO  310  1=1. NOCAT 
DO  310  J=1.N0SUB2 
IF  (CATVEC(J)  .NE.  I) 
SUBNOd)  s SUBNOd)  ♦ 
K s K ♦ 1 
SUWVECIK)  a J 


GO 

1 


TO  310 


C 

8 


CONTINUE 

RETURN 


CODE  FOR  A TIE 


390 

400 


IF 

DO 

IF 

IF 


(MAX  .EO.  0)  GO  TO  175 
400  IIsl, NOCAT 
(II  .EU.  CATNUM)  GO  TO  400 
(MAX  .EQ.  CATGHYdin  GO  TO 
CONTINUE 

CATVECd)  = CATNUM 
GO  TO  175 


410 


410 


1 


420 


TIE  = TIE  < 

MAXOST  s 0 
DO  *20  J=l.NOOOT 
NO  = DOTNUM(J) 

D5T  = OISTf.C(NO) 

IF  (MAXOST  .6T,  OST) 
nOTNO  * NO 
MAXOST  = OST 
INHEX  r J 

LABEL  = D0TS(4.N0) 
CONTINUE 


GO  TO  420 


ALLOl 
ALL01590 
ALL01600 
ALLOioIO 
NAME) •) ALL01620 
ALL01630 
ALL01640 
ALL01650 


ALL0I660 

11(-- 


ALL01670 

ALL01680 

ALL0169Q 

ALL01700 


ALLOlTiO 
ALL0172P 


ALL01730 


ALL0|749 


ALL01750 

ALL01760 


ALLOl 
ALLOl 790 
ALL01800 
ALL01810 
ALL01820 
ALL01830 
ALLO104O 
ALL01850 


ALLgl86g 


ALL0187( 

ALL01880 

ALL0189Q 

ALL01900 

ALL01910 

ALL01920 

ALL01930 

ALL01940 

ALL01950 

ALL01960 

ALL01970 

ALL01980 

ALL01990 

ALL02000 

ALL02010 

ALL02020 

ALL02030 

ALL02040 

ALL02050 

ALL02060 

ALL02070 

ALL020R0 

ALL02090 

ALL02100 

ALL02110 

ALL02120 

ALL02130 

ALL02140 

ALL02150 

ALL02160 

ALL02170 

ALL02180 

ALL02190 

ALL02200 

ALL02210 

ALL0??20 

ALL02230 

ALL02240 

4LL022S0 

ALL02260 

ALL02270 

ALL02280 


1 


w 


FILE  ALLKIN 


C 

C 


TICS(TIE)  > OOTNO 
CATGRYILABEL)  ■ CATGRYILABEU  - 1 

NOOOT  • NOOOT  • I 
IF  (INDEX  .EO.  (NOOOT  ♦ 1)|  GO  TO  445 

DO  440  IIsINOEXtNOOOT 
440  OOTNUM(II)  « OOTNUM(II^I) 

445  CONTINUE 

max  > 0 

00  470  IIsl. NOCAT  . 

IF  (CATgAy(II)  .LE.  HAX)  go  to  470 
MAX  B CATGRY(II) 

CATNUM  B II 
470  CONTINUE 
GO  TO  390 
END 


ALL02370 

ALL023S0 

ALL02390 

ALL02400 

ALL024iO 

ALL02420 

ALL02430 

ALL02440 

ALL02450 

ALL02460 

ALL02470 


330 


FlU^t  ASCEND 


60 


70 


7S 

RO 


90 


*y22PyiI5^.5l£5&D(SCN,LNCAT,PTRl.PTR2 
IMPLICIT  INTffiE«(A-X> 

OTMENSION  PTBULNCAT)  «PTR2(LNCAT) 

REAL  SCN(LNCAT)«SAVE 

JbO 

J»J*1 

Tr(J.6T.LNCAT)60  TO  90 
tP(J.F0.LNCAT>60  TO  75 
■ (SCNCJ)  ,6T.  SCNJJ41))  60  TO  70 
60  TO  60 


,P 


ASCOOOlO 

ASC00020 

ASC00030 

ASC00040 

ASCOOOSO 

ASC00060 

ASC00070 

ASCOOOAO 

ASC00090 

ASCOOlOO 


SAVF»SCN(JJ 
SCN(J)»SCN(J*1 ) 
SCN(J*1)«SAVE 


Ascoono 

ASCOOfPO 


SAVFlapTRl <J) 

PTRl <J)*PTR1 (J*l» 
PTRl (J*l)«SAVEl 


SAVF?*PTP2(J) 

PTH2(J)«PTR2(J*1) 

PTP2(J*n«SAVE2 

K*J 

IF(K,FCi.l)60  TO  60 
IF  (SCN(K)  ,6T,  SCNIK-D) 


60  TO  60 


SAVF«5CN(K-1) 

SrNC<-l)*SCN(K) 

SrNJK)«SAVE 


SavPlsPTRl (K-1) 
PTRl  (K-D.PTRl  (K» 
PTRl (K)«SAVE1 


SavF2=PTR2(K-1  ) 

2<K) 


PTR?(»f-l  )«PTR 
PTR2(K)*SAVE2 


KsK-1 
60  TO  PO 


CONTINUE 


RETU 

END 


ASC00130 
ASCOOUO 
Ascooiso 
ASC00160 
ASC00170 
ASCOOISO 
ASC00190 
ASC00200 
ASC00210 
ASC00220 
ASC00230 
ASC00240 
ASC002S0 
ASC00260 
ASC00270 
ASC00280 
ASC00290 
ASC00300 
ASCOOSIO 
a|C0032 
ASC0033U 
ASC00340 
ASC003S0 
ASC00360 
ASC00370 
ASC0C360 
ASC00390 
ASC00400 
ASC00410 
ASC00420 


FILFJ  CL»KEY 


8. 

C* 

C* 


SUBROUTINE  CLRKET(XSlZ«10ATA«N0SUB2tCHfHEANStNC> 


CLRKvs  ADDS  The  color  keys  to  a universal  format  tape 

THE  COLORS  ARE  OUTPUT  AS  SQUARES  IMAGES  (10X10) 
implicit  integer  IA-2) 

DIMENSION  1DATA(XSIZ*CH) 

REAL  MEANS (NC*NOSUB2) 


C* 

C« 


oo 


LSTLIN  ■ 0 
LINE  » 0 
TOTKFY  “O' 

NKFYS  « XSIZ/11 
NOKEY  ■ NOSUB2 

DO  100  J«1»CH 

WRITE  A SCAN  LINE  OF  ZEROS  • USED  FOR  SEPARATING  THE  THE  COLORS 


C 

C 


100 


110 


no  100  i»i.xsiz 

IDATA(I«J)  • 0 

CALL  WRTLN(10ATA«LSTL1N) 
LINE  « LINE  ♦ I 

IF  (NKEYS  .LE.  NOKEY)  NOKEY 
KK  ■ 0 


NKEYS 


C* 

f 

C* 


)TO 

140 


ISO 


ISO 


no  150  1*1.N0KEY  . _ 

TOTKFY  a TOTKEY  ♦ 1 
DO  140  J*1»NC 
no  130  K«ltin 
KK  e (1-1)«11  ♦ K 

inATA(KKfJ)  « MEANS(J*TOTKEY)  ♦ 0.5 
CONTINUE 

WRITE  A SCAN  LINE  OF  COLORS 
CONTINUE 

NOKEY  ■ NOSUR2  - TOTKEY 
no  160  I»l,10 

IF  (NOKEY  .LE.  0 .AND.  I .EO.  10)  LSTLIN  « -I 
CALL  WRTLNdOATA. LSTLIN) 

LINE  a LINE  ♦ 10  • . 

IF  (NOKEY  .LE.  0)  60  K 170 
60  TO  «J0 


C 

C 


170  CONTINUE 


RETURN 

ENO 


CLROOOlO 

CLR0002Q 

CLR00030 

CLR00040 

CLR00050 

CLR00060 

CLR00070 

CLROOOBO 

CLR00090 

CLROOlOO 

CLROOllO 

CLR00120 

CLR00130 

CLR00140 

CLR00150 

Etggghs 

CLROOIBO 

CLR00190 

CLR00200 

clrooHo 

CLR00220 

CLR00230 

CLR00240 

CLR002S0 

CLR00260 

CLR00270 

clroo|ao 

CLR00290 

CLR00300 

CLR00310 

CLR00320 

CLR00330 

CLR00340 

CLR00350 

CLR00360 

CLR00370 

CLR00380 

CLR00390 

CLR00400 

CLR00410 

CLR00420 

CLR00430 

CLR00440 

CLR00450 

CLR00460 

CLR00470 

CLR00480 

CLR00490 

CLR00500 

CLR00510 

CLR005Z0 


ORIGINAL  PAGE  IS 

OF  POOR  QUAUTN 


riLFi  CLSHAP 


SUHROUTINF  CLSHAP(CATSUB«SWTCH*SUBNO*SUBVeCtSUBOES*CATVEC) 
OUTPUTS  LINE  PRINTER  MAP (CONDITIONAL  AND  MlxEOI 
OUTPUTS  MAPFIL  TAPE 


SWTCH  ■ 1 — CONO.  MAP 

SmTch  ■ ? — mixed  map 


?ss54:t  15 

INCLUDF  COMaKA.LIST 

C0MM0N/1NF0OM/N0CLS2»N0SUB?»N0FET?.VARSZ2*T0TVT?iN0FL0?. 

AyAP?,C0VAR?.CLSI02.SU8N02»SUB0S2.FL0SV?tVER 
FETvC2(30>.SUBVC2(75>.SUBPTR(7S» ,CLSVC2(60) » 


FETVC2<30>.SUBVC2(75>.SUBPTR(7S»iCLSVC2 
KFPPTS(60> •N06RP*GHPNAH(60) tGRBOEXCGl) • 


VERTX2f 


3S/NOCAT«CATNAM(60)  tNOCL2 1 CLSNM2 ((SO ) .N0CAT2»C 
PURPAY (120) .PTP(60) .CaTPTP(250) *CAT00T (SOO) * 

OnTV|C(250) .cond»hix.proc.mapkey«dotkey»sta 
(NEAPST.OIST.NOFEAT.FETVECOO)  .OMAPUN.OMAPFI. 


•S'0”l'l'’**»''^PS.»'<iArRtY»DOTKEY»STATKt« 
5y5!*NG;.T,NEAPST.0!ST,N0FEAf,FETVEC<30)  .OMAPUN.OMAPFIf 
0SAVTP,0STaFI»N0SUN.AN6L|(8) »SIZEfTOTOT?»FL0lNF((S) * 

CLSSymISZ) ♦STAnPS.MEANAP«TABA0PiMAPA0RiSUNC0R(3n)  • 
«„..»-9D9^'^'^*^OOTFY.MANSTA.MANOOT»l)SPUNTfnSPFIL»OSPKEY»PRNSTS. 
PRNQOT.FtnNAM, VERTEX (?2) .N0VPT»NSUN,ANGLES (B) 
♦TOTDT3,FLDAOP.VTXAOP 

COMMON/GL08AL/MFAO(63) ♦MAPTAPtDATAPE»SAyTAPi8MFILE«RM»(EY* 

^ HlSFIL«HlSKeY.TRFORM*ERlPTP«ERPKEY«MAPUNT»NOFILEt 

OPUMAOtnPMwOStPAGSIZ.OATFILfSTAFlLtASAVtASAVFL 


NOFILE1 


.NMSTUNtNMjTFI .SCTPUN.MAPFIL 

f i*-  • nchp  ASt  trnsfl  t bmtrfl  *m  i stfl  t pcmunt* 

CPOUNTtPWTUNT.kANDlO 

DIMENSION  mEDI  (15)  tMED2(15)  .DATE  (3)  .COMENTdS) 
.equivalence  (MFDl ( 1 ) .HEAD (4) ) , (DATE ( 1 ) .HEAD (22) ) . 

(HE02(i) .hEa5(30) ) « (COMENT(l) «HEA0(48) ) 


SION  SyRVEC(l) 

SION  f!TL|(3.2). 

SION  SYMBOL (62) 
TITLE/*CONO*.*ITIO».»NAL 


COL(3.110) 


Mp.*XEO 


SYMBOL/*  1 'S'. U'.'S'.'N'.d'.'H'.tR'.iA*. 

••“•.•C».»D'.‘E*.*F»»'G'.*M*.»p.»J*.tK*. 

•l«.'m».»n».‘5*.*p».*o*.'R».*s»»*t*.«u*. 

(V'.«W«.*X'.'Y'.'Z'**>'. 

•it.*)«.**».»(».ilH*( 


•NSION  CATS 

fNsioN  Toat 

. PPLCLR 
iNSION  CATV 


XTSURd  ) .SURNOd)  .IR  (1000)  .OUT  (1000)  .COLORS  (62) 
OATA(IOOO) .RELCLR(60) 


DIMENSION  SUHOESIGO) 

DIMENSION  COLOP(64) .COLATE(60) .OELETE(60) 


DATA  COLOR/  1.207.7V. 111. 47. 175. 143. 71. 
167.  ms.  107. 17 1.1 99.  135. 39. 71. 
P0S.137.7S.4l.45.69.73.75. 


• 77.133.137.139.141.33.35,37. 

• 39.41.43.45.47.103.105.107. 

• 109.197.201.203.205.169.171.173. 

• 131.135.137.141.67.71.75.77, 

• 161 ,163.165.167.169.171,225.239/ 
data  1PMD/'«**/ 

COl  0PS(n0SUM2  • 1)  » COLOR(l) 

COLORS  (N0SUO2  * 2)  » COLOR  d) 

CHFC*f  FOP  DELETED  CATEGOPlES 
KEPT  ■ 0 

DO  2 II  « 1. NOCAT 
DELFTEdl)  » 0 
DO  1 1 » 1.N05UB2 

IF  (CATSURil)  .EO.II)  OELETEdI)  » 1 
CONTINUE 

kept  ■ kept  ♦ OELETEdI) 

CONTINUE 

IF  (KEPT.EO.O)  go  to  7 
II  » I 
smalls  b 0 


CLSOOOIO 

kL|00020 

^LfoooSo 


GPPCHK (61 ) .6P0UPS (124) 

common  /LABS/NDCaT.CaTNAM(60) .NOCL2.CLSNM2(60) *NOCAT2.CATNM2(60) . 


CLSOO  Id 

!!8 

CLSOO  40 
CLSOO  50 
CLS00160 
CLS00170 
CLSOO  80 
CLSOO  90 


CLS00200 

CLS00210 

CLS00220 

CL500230 

CLS00240 

kmti 

CLS00|70 

CLS00280 

CLS00290 

CLS00300 

CLS00310 

clsoo5|o 

CLS00330 

CLS00340 

CLS00350 

CLS00360 

CLS00370 

CLS00380 

CLS00390 

CLS00400 

CLSOO4I0 

CL500420 

CLS00430 

CLSO0440 

CLS00450 

CLS00460 

CLS00470 

CLS00480 

CL500490 

CLS00500 

CLS00510 

CLS00520 

CLS005SO 

CLS00560 

CLSO0570 

CLSOOSRO 

CLS00590 

CLS00600 

CLS00610 

CLS00620 

CLS00630 

CLS00640 

CLS00650 

CLS00660 

CLS00670 

CLS006RO 

CLS00690 

CLS00700 

CLS00710 

CLSO0720 

CLSO0730 


nor>  n r>orio 


FILFt  CLSMAP 


3 SM*LL  ■ 2««3n  * (2*«30-2) 

if  IS8::lii:iaj|:tf'*8*T5°,‘ 


A 

.7 


10 


in  * I 


CMALL  ■ OUM 
CONTINUF 

COLAtFjnil  ■ II 
«M*LL'S  • SMALL 

IF  (D|^£TC(lXl).E0.0>  00  TO  6 


CONTINUE 


<EPT)  60  TO  3 


ASSI6N  CATEOORY  SYMBOL  TO  EACH  CLUSTER 
00  10  I>1.N0SUB2 


CaTnum  s CaTSUR<|) 
CLSSYM(I)  > SYMrOl  - 
JF  (CATNUM. of. NOCAT) 


OIJM 


OELETEU) 
rOl.OMS(I) 
00  TO  10 
coLO»s<n 
( I ) 


(CATNUM) 
. T)  60  TO 
COL  ATE (CATNUM) 


OUM 
COLON (OUM 


♦ 1) 


COLOR (6A  ♦ KEPT  > CATNUM) 
63  * kept  - CATNUM 


OFLETE 
CONTINUE 

CLSSVM  (NOSUB?  ♦ 1)  « IPNO 
CLSSYM  (NOSUfl?  ♦ ?)  ■ IPNO 
CALL  SFTMNG(6a*0.6B) 

WRfTE(A.HEAO) 

CALL  HAPHNO (NOCAT f CLSSYM. CATNAM.CATVECtSUBOES.CATSUB) 

WBTTF (6,5) (TITLE(I.SWTCm),I«1.3) 

5 FOOMAT (//50X,3A4, ‘CLUSTER  HAP*/) 


ISTBT  > 
lENp  a 
SAMTNC 

LInInc 

LINSTP 
LINENO 
ILINE  > 
nsamf>  1 
PTS  a ( 


: FLni*lF(A) 
FLD1nF(5) 

» FL01NF(6) 

« FLOInFO) 

* FLniNF(l) 

« FL01NF(?)  ' 

: (LlNENO  - LIN« 

(IEno-istrt)/! 


TR)/L1NINC 
AHINC  ♦ 1 


♦ 1 


POSITION  TAPE 
PFWTNO  OMAPlIN 

)F(OMAPFI,NF.O)  CALL  FSFMFL(OMAPUN.OHAPFI.ISTAT) 
CALL  WRThEOO.l.NSAHP.l.OMAPUN) 


PRINT  LINE  PRINTER  MAP 

IPFLA6  « 1 
GO  TO  500 

14  CONTINUE 
II  a 0 

IPTS  * NSAHO 

IF  (l.’TS  ,GT.  no)  IPTS  ■ 110 
IF  (NSAMP  .LE.  1)0)  60  TO  15 
IPO  z NSA^'H  - 110 

15  CONTINUE 

00  300  1»L1nSTH,L1NEND. LINING 
II  « II  • 1 

PIXAOR  « DNUmAO  ♦ (II-1)»NSAHP 
CALI  RREAniPUADN.IR.NSAHP.ISTAT) 
?0  IF  (ISTAT  .FO.  1)  60  TO  ?0 

ORUM  AHONESS  HAPAOR 

no  30  Jal.NSAHP 

1 » IO(J) 

IF  (L  .NE.  0)  GO  TO  25 
inATA(J)  s 0 


CLS00e2O 
CLS0083Q 
CLS00S40 
CLSOoeso 
CLS00B60 
CLS00670 
CLSOOeBO 
CLS00690 
CLS00900 
CLS009/ 0 
CLS00920 
CLS00930 
CLS00940 
CL|o0950 
CLS00960 
CLS00970 
CLS009B0 
CLS00990 
CLSOIOOO 

knim 

CLS01030 
CLS01040 
CLS01050 
CLS01060 
CLS01070 
CLSOIOBO 
CLSOIOPO 
CLSOllOO 
CLSOlllO 
CLSOl 120 
CLSOII2O 
CLSOl 140 
CLSOl Iso 
CLS01160 
CLSOl 170 
CLSOl iao 
CLSOl l90 
CL501200 
CLS01210 
CLS01220 
CLS01230 
CLSoI|40 
CLS01250 
CLS01260 
CLS01270 
CLS012B0 
CLS0l290 
CLS01300 
CLS01310 
CLS01320 
CLS01330 
CLS01340 
CLSOUSO 
CLSOl 360 
CLS01370 
CLS013BO 
CLS01390 
CLS01400 
CLS01410 
CLS01420 
CLS0l430 
CLS01440 
CLS014S0 
CLS01460 
CLS01470 
CLS01480 
CLSOl 490 
CLSOISOO 
CLSniSlO 
CLS01S20 
CLS01530 
CLS01S40 
CLSOISSO 
CLS01S60 
CLbOlSTO 
CLSOlSflO 


riLr:  CLSMAP 


60  TO  30 
O(lTiJ)  ■ 
‘ »TAC 


IDA 
WRITE 


MKSikiu 


(J) 


IDATA  OUT  TO  TAPE 


CALL  WRTLNdOATAtLSTLlN) 

WRITE  REMAINDER  Of  PIXELS  ON  DRUM  FOR  SUBSEQUENCE  WRITING 


^0 

300 


AO 


SOS 


30A 


2*0 


maPOPM  • HAPADR  ♦ (|1-U*1P0 

CALL  RWRI T£ (M*P0«Hf OUT  I U 1 » . IPD* ISTATI 

wRTTF(6«60n*  (OUT  (iK)»lK>!«!PTS) 

format (?X«ISf2X.llOAn 

rONTlNUP 

XSI2  « NSAMP 

CH  ■ 1 

00  AO  I > 1*N0SUP2 
PELCLR(I)  « COLORS ( I) 
rONTlNUE 

^AI^L^^LRKEY(XSlZ«I0ATA«N0SUB2tCHtRCLCLR«CH) 

iPDi  ■ iph 

p|s"«®PTS  * IPTS 

IF  (PTS  .GE.  NSAMP)  SO  TO  360 

If 

lENOS  » ISTaRI  * IPTS  - 1 
IP01«  IPOl-  IPTS 

PRINT  rest  of  map 

IPFLAG  B 2 
GO  TO  500 
CONTINUE 

00  35G  IbLINSTR.LINENO. LINING 
II  *11  ♦ I 

maPORM  b MAPAOR  ♦ (II-T)» 

' - --  - ^ 


CALL  RRtAD(MAPOHM,OUT*II 
IF  (ISTATl  .FO.  1)  GO  TQ  3; 


S?ATl» 


360 

3T0 

375 

?r 

500 


A1 

»? 


*3 

<jn 

AS 


write (6,?*0) I* (OUT(IK) *IKb1START*IEN0S> 

FORMAT (2X.j*.iXtliOAn 
ISTaRT  b IENOS  ♦ i 
r-0  TO  305 

FINISHED 

fONTINUF 
wotTF (*, 370) 

format  OH^«»  NEW  ORDERING 

F0RM*U///^?3X.  • old  new  CAT  COLOR  ORDER 

DO  11  I « 1«N0SUB2 

WRTtE(G.3H0)  I.CaTSUB(I) iDELETE(l) tCOLORS(l) 
FOPM*T(?OX«*(I6*6XJ) 

CONTINUE 

CALL  SFTMRG(6A«*t62) 

RETURN 

CONTINUE 
J B n 

00  A1  IJ  B ISTRT.  lENOf  SAMINC 
U * ♦ 1 

COl(l»jf  » IJ/100 
C0U2tJ)  * MO0(  IJ*  100)/10 
C0LI3.J)  ■ MOO(IJ.iO) 

IF  (J  .FU,  110)  GO  TO  A2 

CGNTINuE 

SAMFN  B IJ 

ISTRT  B SAMEN  * SAMINC 
JPTS  B j 
WOTTF (6,95) 
nOR3IJBl»3 

WOTTF  (6*  90)  (COL  (IJt  J) • J b 1«  jPTS) 

FORMAT  (9X,  lion  ) 

WPTTF (6.9S) 

FORMAT (/) 


1930 
9*0 
>50 


CLS02006 
CLS02010 
3L|02020 


AND  COLOR  KEY  COOFSM 
COLORS*//) 


hisi 
aisL 

CLS02i90 

CLS02200 

CLS02210 

CLS02220 

CLS02230 

CLSO??*0 

CLS02250 

CLS02260 

CLS02270 

CLS022R0 

CLS0?|90 

CL502300 

CLS02310 

CLS02320 

CLS02330 

CLS0?3*0 

CLSOPSSO 

CLS02360 

CLS02370 


ritri  as«*p 


i;  :IS:  M SS 

END 


3yo^ 


or*' 


riLFt  CNf)W/lF 


C 

C 


C 

C 


SU«ROUT 1 ME  CNDMaP (DOTS « CNDSUH « CAT VCC ) 
FLAGS  THE  CONDITIONAL  CLUSTERS 


|aL  OSTNtOISfl 


Et»  (A-Z) 
UN(60)«D 
NC 


ISTnC IZSO) tOOTS (SIZE*TOTOT2) *CaTVEC ( 1 t 


:^S?iNpSyN?iNOF 

kCRFTS  («p) «nP6RR«GRFNaNC60) «6RF 


.CnVANF.CL! 

?no)  «suNV( 


j;sENO 


r' 

N| 

p 

...  JonruUL 

.LUDF  CMmriSff 
COMMON/ 1 NFOMM/Ni  _ 

, GRPCHK  (<.])« GROUPS  (124) 

COMMON  /LAPS/NOCAT«CATNAM(60) *NOCL2*CLSNM2(60) t 

SUPRAT  (ifO)  #PTR(60)  «CATP 

00TylC(2SA)  * 

SUNAN5,T*NFARST«01ST.N0FEAT*FETVtC(3 
OSAVTP.OSTAFI.NOSUNf angle (8) »SIZF»fi 
C«.SStM(62).STaO  * 
OCi>TUN«OnOTFl«MANSTA*MANDOT*OSPUNT*nSPFI 
PRNIinT,FLnNAM,vFHtE» (22) •NOVPTtNSUN* ANGLES (81 
«TOTOT3«FLnAOR«VTXA5H 


VERTK2* 


^l'x(6l)» 

NOCAT2*CATNM2(80)« 
OT(500)« 


rATKt, 


tPTR(60) «CATPTR(2SQ) tCATOOT (SOO) * 

) .CONOsMiK.PROC.MAPKEYtOOTKEY.StA 
•NOFEAT*FETVtC(3n)*OMAPUN«OMAPFi* 
f (8)»SIZF»T0T0T7*FLD1NF(8) ♦ 
HSfMEANAD*TA8AOR»MAPAORi|UNCOR(3Q 
. M ANDOT  * OSPUNT  « DSPF I L » OSPKE  Y • PRNS 


find  all  conditional  CLUSTERS 

NFKT  • 63 
DO  ion  I«1*N0SUR2 
IftO  CNOSUR(i)  > CATVEC(l) 
no  200  IsltNDSU82 
TARl  ■ TASADR  ♦ (1-1)«TOTOT2 


no 


CALL  RREA0(TAB1.DI5TNC.T0T0T2.ISTAT) 
IF  (ISTaT  .EO.  1)  60  TO  110 


IF  (D0T5(4,j)  ,NE. 


TNC(jj)  II  )GO_T0.120. 


[F  (nOTS(4,j)  ,NE.  LA 
DSTN  > OISTNC(U) 

1?0  CONTINUE 


COMPARF  TmhFSMOLO  value  T 

IF  (DSTN  ,LP.  T)  60  TO  200 

flag  as  CONDITIONAL 

NE*T  « NEXT  - 1 
CNOSUH(I)  > NEXT 

200  CONTINUE 

RETURN 

END 


60  TO  120 


_ , ) ♦ 
iNSTSf 


COM«  ^ 

coMooc.. 

COM00030 

COM00040 

COMOOOSO 


CN000140 

CNOOOiSO 

CN000160 

CND00170 

CND00180 

cnDooIro 

CND00200 

CNDOOliO 

CNp00220 

CN000230 

CND00240 

cnoooHo 

CNOOOi 

CNOOOl - - 
CND00300 
CN000310 
CND00320 
CN000330 
CN000340 
O^0003S0 
CN000360 
CN000370 
CNp00380 
CND00390 
CND00400 
CN000410 
CN000420 
CND00430 
Cn500440 
CN0004SO 


r»nr>o 


FILFI  CROSCN 


C 

C 


100 


no 


FUNCTION  CROSCN ( C ARD. 6RP0E  X « 6RPNAH  t GROUPS  * N06RP  * GRPTR ) 
IMPLICIT  INTEGER  <A-H*0-Z) 

OIMENSION  CAR0(62),  C0MVEC<2»*  NUMVECC301 

DIMENSION  6RP0EX  < I ) ,GRPNAM ( 1 ) , GROUPS  < 1 ) 

LOGICAL*!  LHA).L?(32) 

EQUIVALENCE  (WR01<L1(1) ) « (L2  0)  «BUF(in 

DATA  blank/*  */t  COMMA/*. •/»  COMVEC/1 . * » */ 


10 


20 

30 

40 


SO 


COL  s 0 

J * NXTCHR(CARD.COL) 

IF  (J.FQ. BLANK)  GO  TO  110 

DO  10  I*l.« 

j|  » CAWD(COL-l*n 

IF  (J2.EQ. COMMA)  GO  TO  20 

PUF(I)  r ^2 

GO  TO  40 

DO  30  J«1.8 
PUF(J)  = BLANK 


N s 1 
DO  50 
Lid) 
N s N 


«0 

RO 


1 = 1.4 
= L2(N) 

♦ 4 
CONTINUE 

6RPNAM(N06H°»1)  = MROl 
J = FIND12(CA«O.COL.COMVEC) 

IF  (J.LE.O)  GO  TO  no 

J = NUM8EH(CAHO.COL»NUMVEC.O) 

II  = 0 

DO  90  Tsl.J 

JJ  = NUMVEC(l) 

II  = 11*1 
NUMVECdl)  = JJ 
CONTINUE 

IF  (II.LE.O)  60  TO  110 

NOGRP  = NOGRP*l 
PRDTP  X GHPTP  *1 
GRPOEX(NOGRP)  = GRPTR 
GROUPS(GRPTW)  s II 

no  100  1=1.11 

GROUPS  (GRPTR*  I)  = NUMVECd) 


GRPTR 

CROSCN 

return 


return 

END 


GRPTR*II 
= 0 


CROOOOlO 

CRD00020 

CR000030 

CRD00040 

CRDOOOSO 

CRD00060 

CRD00070 

CROOOOBO 

CRD00090 

CRDOOlOO 

-CROOOllO 

-CRD00120 

CR000130 

CR000140 

CRD00150 

CB000160 

CR000170 

CR000180 

CR000190 

CRD00200 

CRD00210 

CRD00220 

CR000230 

CR000240 

CWD00250 

CRD00260 

CRD00270 

CR000280 

CR000290 

CRD00300 

CR000310 

CR000320 

CRD00330 

CH000340 

CRO003S0 

CRD00360 

CP000370 

CRD003HO 

CHD00390 

CR000400 

CRD00410 

CROOOA20 

CRD00430 

CRD00440 

CR000450 

CP000460 

CP000470 

CRD00480 

CPD00490 

CR000500 

CWOOOblO 

CROOOS20 

CR000530 

CROOOS40 

CRD00S50 


i'' 


1 .ui::  IS 

QUALITY 


ooooooo  oon  oooo  non  non  r>  rtr»r»r»  r>r»o 


FILFJ  OOTOST 


SUBROUTINE  nOTOST (MEANS. DOTS. TABLE. TOP) 

COMPUTES  LI  OR  L2  OISTANtES  AND  STORE  ON  DRUM 

IMPLICIT  INTEGER  (A-2) 

INCLUDE  COMNkI.LIST 
INCLUDE  COMHKA.LIST 

iNCLUOE  C0MMK6.LIST 
NCLUOE  CMHK15.L1ST 

OMMON/lNFOMM/NOCLS^.NOSUR?,NOEET2.VARS72.TOTVT2.NOELn?. 

• AVAR2,C0VAM?,CLSI02.SUBN()?.SUR0S2.FL0SV2.VERTX?. 

• ' feTVC2(30) .SUBVC2<7S) .SUHPTH(7|) .CLSVC2(60) . 

• KEPPTS(f>0)  .NOGRM.6MPNAM(60)  .6RPDEX(61)  . 

♦ GRPCHK (61) .GROUPS (12*) 

dimension  HEOl  (IS)  .ME02(1S)  .OATEO)  .COMENT(IS) 

FOUfVALENCE  (HEDl ( 1 ) .hEAO(*) ) . (DATE ( I ) .HEAD (22) ) ♦ 

2 (HED2(1)  .hEADOO)  ) . (COMENT(l)  .HEAD(*8)) 

C0MM0N/GL08AL/HEAIH63) .MAPTAP.nATAPE.SAVTAP.BMFILE.BMKEV. 

* hiseil.hiskey.trform.epiptp.eppkev.mapunt.noeile. 

♦ DRUMAO.nRMwnS.PAGSlZ.DATFIL.STAElL.ASAV.ASAVEL 

• .nhstun.nhstfi.sctrun.hapfil 

* .DOTUWT.UOTFIL.NCHPaS.TRNSFL.BMTREL.HISTEL.PCHUNT, 

• CRDUNT.PRTUNT.RANDIO 

COMMON  /LAB5/N0CAT.CATNAM(60) .NOCL2.CLSNM2(60) .N0CAT2.CATNM2 (60) . 
• SUPPAY (120) .PTR(60) .CaTPTR(250) .CATDDT(SOO) . 

• D0TVEC(2S0) .COND. mix. PROC.MAPKEY. hotkey. statky. 

• SUNaNG.T.NFAPST.OIST.NOFFAT.FETVEC  C<0) .OMAPUN.OMAPFI. 

* OSAVTP.OSTAFI. NOSUN. angle (fl) .SI ZE. T0TDT2.FL0INF (6) . 

• CLSSYM(62)  .STAnRS.MEANAD.TABADP.MAPADR.SUNCOROO)  . 

• OOOTUN.ODOTFI.HANSTA.MANDOT.OSPUNT.OSPFIL.DSPKEY.PRNSTS. 

• PRNnOT.FLDNAM, VERTEX (22) .NOvPT.NSUN, ANGLES (8) 

* .TOTOT3.FLDAOR.VTXADR 

:EN0 

DIMENSION  nOTS(SIZE.l) 

REAL  TABLE(TOTDT2,l) 

DATA  CLSTW/'CLST'/, BLANK/.  •/ 

PEAL  MEANS(NOFET2.1) .DSTN. OISTNC(250) .SUN. SUNCOR 
TABAOR  - DRUM  ADDRESS  FOR  STORING  DISTANCE  TABLE 
TA91  s TABAOR  . . 

retrieve  SUN  angle  corrections 

IF  (SUNaNG  .EO.  0)  60  TO  19 

SMTCH  5 1 - SUNANGLES  ARE  USER  INPUT 

= 0 -SUN  angles  are  on  dot  file 

TF  (SUNaNG  .NE.  1)  GO  TO  18 
SWTCH  = 0 

CALL  SUNFaC (SUNCOR. angle. FETVEC. NOFEAT. SWTCH. dummy) 

GO  TO  19 
lA  SWTCH  = 1 

CALL  SU  (FAC (SUNCOR. ANGLES. FETVEC. NOFEAT. SWTCH. DUMMY) 

19  CONTINUE 

DO  200  I=1.N0SUB2 

ZERO  OUT  ARRAY 

00  20  IJ=1.T0T0T2 

20  OISTNC(IJ)  = 0 

COMPUTE  distance  BETWEEN  ALL  DOTS  FOR  EACH  CLUSTER 

oist  = I — u distance 

=2  — L?  distance 

00  100  J=1.TOTOT2 
DSTN  =0 

no  50  k=1.n0FET2 

SUN  = SMNroP(K) 

nSTN  r SUN*OOTS  (*♦•<.  J)  - SUN*mEANS(K.I) 

GO  TO  (30.*0).0ISt 

30  OISTNC(J)  = DISTMC(J)  ♦ ABS(OSTN) 

GO  TO  SO 


FTLF:  nOTOST 


40 

so 

100 


D1STNC<J)  S 
CONTINUE 


DISTNC(J)  ♦ DSTN**? 


2)  DISTNC(J)  a S0RT(01STNC(J)) 

8i»oif 


no 

200 


?S0 


245 


240 

241 

242 
?45 


275 

?40 


IF  (DlST^.EOa  _ . _ 

: ::  :_sTNc»T0T0T2.isTAt» 

TABl  a TABI  ♦ T0TDT2 
IF  (ISTAT  ,EQ.  1)  GO  TO  110 
CONTINUE 


WRITE(4.HEAD) 

W»TTE(6,250»  > 

F0OMAT(//T50t 'CLUSTER-DOT  INTEM-OISTANCE  TABLE') 

5UR2  a N0SUO2 
TAPI  a TABADR 
NSUR2  a 1 

M0GRP5  a TOP/TOTOT2 
IF  <NOGPPS  .GT.  14)  N06RP5  a 15 
IF  (NOGRPS.GT.  sup?)  NOGRPS  a SU02 
TOTWDS  a T0TDT2  * nOGRPS 

CALL  RRE AD < T ABl. T able »TOTwnS» ISTAT) 

TSUB2  a NSUB?  ♦ NOGRPS  - 1 
WPITF <4,240) (CLSTP  ,Ial, NOGRPS) 

WBTTF (4.2bl) (BLANK, SURVC2(K) ,KaNSUB2tTSUB2) 
F0RW4T (//8X,15(4X,A4) ) 

FOR'^aT  (4X,  'OOTS',3X,1S(A1,  ' ( ' , 1 2,  ' ) • , 3X)  ) 

4BTTF (4,262) 

FORMAT ( ) 

TF  (ISTAT  .FO.  1)  GO  TO  265 
DO  240  Ial,T0TDT2 

WRITE (6,27S)00TVEC( I) , (TABLE (I, J) ,Jal, NOGRPS) 
F0PmaT(*»x,I3,1h.,15(1x,F7.2)  ) 

CONTINUF 

TARl  a TABI  * TOTWDS 
NSUB2  a TSUR2  ♦ 1 

NOGRPS 

0)  GO  TO  245 


SUP?  a 5UB2  - 
IF  (SUB?  .gT. 


RETURN 

END 


DOT00800 
OUT00810 
0OT00820 
POT00830 
DUT00840 
OOTOOB50 
OOT00860 
OOT00870 
DOT00880 
0OT00890 
DOT00900 
OOT00910 
DOT00920 
OOT00930 
DOT00940 
OOT00950 
OOT00960 
DOT00970 
r>OT009fl0 
OOT00990 
OOTOIOOO 
OOTOlOlO 
DOT01020 
OOT01030 
DOT01040 
DOT01050 
DOT01060 
OOT01070 
OOT01080 
OOT01090 
DOTOllOO 
OOTOlllO 
DOT01120 
OOTOll 30 
UOTOl 140 
DOTOl 150 
UOTOl 140 
OOT01170 
OOT01180 
OOT01190 
DOT01200 


Ox 


. , I 'rr 

■■  ‘‘m  Qn-:-;. 


nnn  o r>  r>r>  noo  oon  r>  orior> 


FILFI  nSPTAP 


SUPPOUTTNE  ^SPTaP(SUHNO»SUPOFS*FLOSAV.VEPTX.CATVEC*SUBVEC»ME*NS. 

• C0VAS<tT0P»nATA*NOFl.D»T0TV«T) 
implicit  INTEfiEo  <A-Z> 

TNCH'OF  COMPKI.LIST 
INCLUnE  C0MMK4.L1ST 
INCLUDF  C0Ma^6»LI<iT 
TNCLUDF  CMP<l«k,LlST 

COHMON/1nFO'^M/nOCLS?,NOSUP?.NOFET2»VAPS72.TOTVT?»NOFLO?» 

• AVAP?.COVAR?,CLSin2,SUBNO2.SUB0S2.FL0SV?»VEHTX2» 

* FETVC2(30)  .5UFiVC2(?S)  »SU9PTR«7S>  «CLSVC2(60)  ♦ 

• kfPPTS(isO)  .NOfiHP*GRPNAM(60>  ♦6RPDEX(6l)  t 

# ' fiRPCHK(f,l).GRUUPS(124) 
dimension  HEPl (IS) »HEn2(lS) ♦OATF ( 3) . COMENT ( IS) 

EOl'I valence  (HEOl ( 1 ) .HEAD (4) ) ♦ (DATE ( 1) .HEAD (22) ) . 

2 (HE02(1)  .HEAD(3(t) ) « (COMENT(l)  »HEA0(48)) 

C0MM0N/GL0aAL/MFA0(63) .maptap.datapf.savtap.rmfile.bmkey. 

HISFIL.HISfEY.TRFORM.ERIPTP.ERPKEY.MAPUNT. NOFILE. 
nPIlHAO.nRMwos.PAGSIZ.DATFIL.STAFIL.ASAV.ASAVFL 
,Nw«;ThN,NHSTFI.SCT«iiN.M4PF1L 

.nOTUNT.OOTFIL.NCHPAS.TRNSFL.BMTRFL.MISTFL.PCMUNT* 
rRDUNT.PMTUNT.RANOIO 

COMMON  /LABS/NOCAT.CATNAM(FO) .N0CL2.CLSNM2(60) .NOCAT2.CATNM2 (60) . 
Sl)P°AY(120) .PTP(60) .CATPTP(250) .CATDOT (500) . 

DOTVEC (?S0) .CONn.MlX.PPOC.MAPFEY.OOTKEY.STATKY. 
Sl)NANfi,T.^■|4»ST.i.■)IST.N0FEAT.FEtvEC(30)  .OMaPUN.OMAPFI. 
OSAVTP.OSTaFI. NOSUN. ANGLE(«) .SIZE.T0TnT2.FL0INF (6) . 

CLSSYM(62)  .STAnPS.MEANAU.TABADR.MAPADR.SUNCOROO)  . 
OOOTUN.OOOTFI.MANSTA.MANDOT.OSPUNT.nSPFIL.OSPKEY.PRNSTS. 
PRNOOT.FLONAMvVFWTFX (22) .NOVRT.NSUN. ANGLES (8) 

.TnTDT3.FL0A0R.VTX ADR 

DIMENSION  SUBNO ( 1 ) .SUROES ( 1 ) .FLDSaV (4. 1 ) . VFPTX (2. 1 ) .CATVEC ( 1 ) 
DIMENSION  SUHVEC( 1 ) .DATA ( 1 ) . IP ( 1 000) .NEMSUB(62) 

DIMENSION  CLSVFC(60) .DUMMY(IOO) 

PEAL  means (NOFET2.1) .COVAR ( VARSZ2. 1 ) . VR ( 1000) 

POSITION  TAPE 

CALL  FSRSFL(nSPUNT.OSPFIL.IST)  . 

RUN  header  record  NO.  1 

no  10  1=1.100 

10  nuMMr(i)=i 

NOFLD?  = NOFLD 
TOTVT?  = TOTVRT 
NCAT  = 0 

JULY  12  1P78  nocat  USED  INSTEAD  OF  NCAT  IN  MAPTaP  FIRST  RECORD 

WRITE (DSPUNT) (PATE (I) .1=1,2) . (DUMMY ( I )♦ 1=1 ,3) .N0CAT.N0FLD2.N0SUB2' 

* NOEFT2, TOTVT?, N0CAT.VARSZ2. (FETVC2(D .I=l.NOFET2) 


*ENO 


40 


K = 0 
DO  40 
TII  = 
DO  40 
K = K 


SO 

60 


I=l,MOCAT 
SURNO(I) 

J=1,III 
♦ 1 

CLSVEC(K)  = I 

RUN  HEADER  RECORD  NO.  2 

WRITE (DSPUNT) (CaTNAM(I) , 1=1. nocat ) . (CATNam(I) ,I=1.N0CAT) . 

• (SUH- 0(1) .1=1 .nOCAT) , (SUHOES 

• ( I ) . 1=1 .MDCija?) . ( (FLDSAV (I. J), 1=1. 4) , J=1 .N0FL02) . ( (VERTX (I. J) 
*♦1=1.?) ,J=1. TOTVT?) . (CLSVECd ) ,1=1.NDSUR?) , ( CLSVEC ( I ) . I = 1 .NDSUP?) 

• , (OURO'Y  ( I ) . 1 = 1 .NOCAT)  . (KERPTS(  I ) , 1 = 1 .NOSUB?) 

PUN  header  record  NO.  3 

MFANl  = STaDPS  ♦ VARSZ2  * N0SUB2 
no  100  J=1.N0SU62 
KK  = SU^’VFCIJ) 

MEANS?  = ^.EAN1  ♦ N0FFT2*  (KK-1 ) 

COVARl  = STAOhS  ♦ VARSZ2*(KK-1 ) 

CALL  RPEAD(COVARl,COVAR(l,J) , V ARSZ?, 1ST AT ) 

IF  (ISTaT  .RO.  1)  GO  TO  SO 

CALL  RRF An(MFANS?,MEANS(l,J) .NOFET2, I ST AT  1 ) 

IF  (ISTaTI  .tU.  1)  GO  TO  60 


100  CONTINUE 


OSPOOOlO 

DSP00020 

DSR00030 

OSP00040 

DSPOOOSO 

DSP00060 

OSP00070 

DSP00080 

OSP00090 

OSPOOlOO 

DSPOOllO 

OSP00120 

OSP00130 

OSP00140 

OSP00150 

DSP00160 

DSP00170 

0SP00180 

DSP00190 

DSP00200 

DSP00210 

DSP00220 

DSP00230 

0SP00240 

OSP00250 

OSP00260 

DSP00270 

DSP00280 

DSP00290 

DSP00300 

DSP00310 

DSP00320 

DSP00330 

0SP00340 

DSP00350 

DSP00360 

DSP00370 

DSP00380 

DSP00390 

OSP00400 

DSP00410 

OSP004?0 

DSP00430 

OSP00440 

DSP00450 

DSP00460 

DSP00470 

DSP004RO 

OSP00490 

OSP00500 

OSPOOSIO 

DSP00520 

DSP00530 

OSP00540 

DSR0OS50 

OSP00S60 

DSP00S70 

DSHOOSftO 

DSP00590 

DSP00600 

OSP00610 

nspoo6?o 

OSP00630 

DSP00640 

DSP006S0 

D5P00660 

PSP00670 

DSP00b«0 

OSR00690 

DSP00700 

DSP00710 

DSP007Z0 

DSP00730 

0SR00740 

OSR007SO 

DSP00760 

DSP00770 

DSP007P0 

DSP00790 


I 


uuo  uuu  u ouuu 


FILF:  DSPTAP 


WPITF(n'iPUNT)  ( (COVAH(I*J)  «Isl«VAPSZ2)  tJaltNOSUBZ)  « ( (MEANSCItJ)  « 
« I«l.N0FFT?)*J>ltN0SUU2) 


PUN  HEADER  PECOPD  NO.  4 


WPTTEtnsPUNT)  ( (COVAPdf  J»  .laltVARSZ?)  tJ-l'NOSUBZ)  • 
• (DUMHY(I) .IxI.NOSUBZ) t (OUHHY(I) «I«l*N0SUB2t 


FIELD  RECORD 


LINSTR 

LINENO 

lining 

5AMSTP 
SAHEND 
SAMINC 
PTS  = 
LINES 


r FtniNFCI) 
s FiPINF(i?) 
s FLOINFO) 
s FLDINF(4) 

= FLDINF<5) 

= FLDINF(is) 

(SAi-ENO-SAMSTP) /SAMINC  ♦ 
= (LINENO-LINSTR»/LININC 


1 


WRITF(OSPUNT)  (FLDINF(I) ,1  = 1,6)  ,PTS, LINES. FL0NAM,N0VRT, 
* (VERTEX (I) .I=l,NOVRT) , (VERTEX ( I*N0VRT) »I«1,N0VRT) 


NEWSU8  — NE4  SUBCLASS  NUMBERS 


no  120  t=l,M0SUB2 

K = SUPVEC(I) 

120  NFWSUP(^)  a I 
no  130  1=1, PTS 
no  vB(i)  = 0.0 
MAP  = nwU'^AD 
ILINF  = LINFS 
NOLINP  = TOP/PTS 

135  IF  (NOLINE  .RT.  ILlNE)  NOLINE  = ILINE 
TOTPIX  = NOLINc  • PTS 
CALL  wREAr»(MAP,DATA,T0TPlX,ISTAT2) 

MAP  = »''AP  ♦ TOTPIX 
137  IF  (ISTAI2  ,F!),  1)  GO  TO  137 
no  ISO  1=1. NOLINE 
II  = IT  ♦ I 

N = LINSTP  ♦ LININC*(II-1) 

nn  uo  J=1,PTS 
iniiMs { i-i ) *PTs*j  • 

JJ  = OATA(inUM) 

140  IR(J)  = NEwSUP(JJ) 

WRITE (nSPUWT)N, ( IR(K) .K=l ,PTS) . (VR(K) ,K=1 ,PTS) 
no  roNTiNijF 

ILINF  = ILINF  - NOLINE 
IF  (ILINE  ,LE.  0)  GO  TO  155 
GO  TO  135 
IS5  N = 0 

write (nsPUNT)N, ( IR( I ) , 1=1 ,PTS) , (VR( I) ,I=1»PTS) 

PT5  = 0 

WHITE (PSPIJNT) (FLOINF(I) ,1=1,6) ,PTS,LINES,FLONAM,NOVRT, 
• (VFwTEXd ) ,I=1,NOvHT) , (VERTEX ( 1+NOVRT) ,I=l,NOvRT) 
ENDFILF  OSPDNT 

RETURN 

ENn 


DSPOOAOO 

OSP00810 

DSP00B20 

DSP00830 

DSP00840 

DSP00850 

DSP00860 

DSP00870 

nspooeso 

DSP00890 

USP00900 

DSP00910 

DSP0C920 

OSP00930 

OSP00940 

DSP00950 

DSP00960 

OSP00970 

OSP00980 

nSP00990 

DSPOIOOO 

DSPOlOlO 

DSP01020 

OSP01030 

DSP01040 

05P01050 

ospoioeo 
DSP01070 
OSP01080 
DSP01090 
DSPOllOO 
OSPOlllO 
USP01120 
OSPOl 130 
nspol 140 
OSPOl 150 
OSPOl 160 
DSP01170 
OSPOl 180 
OSPOl 190 
OSP01200 
OSP01210 
OSP01220 
OSP01230 
OSP01240 
DSP01250 
OSP01260 
OSP01270 
nspni2Po 
DSP01290 
OSP01300 
OSP01310 
OSP01320 
OSPOl 330 
OSPOl 340 
OSPOl 350 
OSP01360 
DSP01370 
OSP01380 
OSPOl  .390 
DSP01400 


I’ouif  (IL'Al.lVv 


L__ 


ooo  ' non  oo  r>  o or>o  r>  oor>  ooo  onrioooooryooo. 


FILCj  FILERO 


<;URPOUTINE  FILFRO ( ARRAY fTOP»NOFLO.TOTVRT»FLOSAV.VERTX) 
READS  IN  ALL  NEEDED  FILES 


DRUM  addresses 


BE'? INNING  AODRES 
PEGlNNlNG  ADORES 


FOR  MAPFIL 

_ . FOR  COVAP  AND  means 

beginning  address  for  distance  table 
beginning  AODRESS  for  NSAMP-110  pts  of  cond.  or 
MI*€0  CLUSTER  MAP 


- BEGINNING  AODRESS  FOR  FIELD  INFO 

- beginning  AnORESS_FOR. VERTICES 


beginning  adores  for  DOT  DA 


SEND 


drumaq 

STADRS 
TARAOR 

mapaor 

FLOAOR 
VTXAOW 
COVAP? 

implicit  INTF.GER  (A-Z) 
limit  = sooo 

INCLUDE  COMbkI.LIST 
INCLUDE  COMRKG.LIST 
INCLUDE  CMhKlS.LIST 

common/ INEOBM/NOCLSZ.NOSUR?.NOEET?tVARSZ?»TOTVT?*NOELO?» 

AVAR?.COVAH?.CLSID?»SURNO?»SUROS?.ELOSV2.VERTX?. 
EFTVC2(30) ,5UBVC?(75»  tSURPTRCTS) ,CLSVC2(60>  » 
KEPPTS(#,0)  tNOGRP*GHPNAM  (60>  .GRPDEX  <6l)  ♦ 

GRPCHK  (hi ) tGROUPSC  1?<*J 

COMMON/GLOBAL/HEflO(63) .MART AP. DAT APE.SAVTAPt0MEILE»SMKEY» 

HISFIL.HISKEY*TRFORM,EHIPTPtERPKEVtMAPUNT»NOFILE» 
DRUMA0.DRMJDb*PA65IZ.DATEIL»STAEIL*ASAV,ASAVFL 
tNHSTUN,NH<;TFI  tSCTRUNtMAPFIL 

.OOTUNT»OnTFIL»NCHPAS*TRNSFL*BMTHFL*HlSTFLtPCHUNT» 

CB0UNT*PPTUNT.RAN0I0 

COMMON  /LAHS/fj0CAT.CATNAM((^0)  tN0CL2»CLSNM2  (f.0)  »N0CAT2»CATNM2  (60)  t 
SUHPay (120) .PIP (60) tCATPTR (2S0) .CATDOT (500) ♦ 
nOTVEC (?S0) .CnND»MIXtPROC«MAPKFY»nOTKEY»STATKY* 
5UNANG,T,Nc-AWST.niST*N0FF aT.FETVEC (30) tOMAPUN.OMAPFI ♦ 
OSAVTP.OSTapI ,N0SUN. angle (B) •SIZE.T0TDT?*FL0INF(6) « 

Cl  «;SY«  (6?)  ,STADPS.MFANADtTABADPtMAPAOP.SUNCORl30)  . 
OOOTnN.nnOTFl.MANSTA,MANOOT.OSPUNT,DSPFILtOSPKEY,PRNSTS. 
PPNnOT.FLr>NAM,  VERTEX  (22)  tNOVRT «NSUN,  ANGLES  ( 8) 

♦TOTOTlfFLOADR* VTXAOR 


ni*«ENSION  ARPAY(I) 

DIMENSION  FI.DSAV(A.1)»VERTX  (2*1) 

DI-ENSION  FETVC3130) 

COVAP?  *1 

READ  IN  MAPFIL  AND  STORE  ON  THE  DRUM 

IF  (MAPKEY  ,EQ.  0)  GO  TO  100 

I = LAREAOIFLDNAM, VERTEX, FLD1NF*N0VRT) 

NOLINE  =(FLniMF(2)  - FLDINF(l) )/FLOINF(3)  ♦ 1 
NSAMP  s(FLDlNF(S)  - FL01NF(4> )/FLDINF(6)  ♦ 1 
TOTPIX  = N0I.INE*NSAMP 


CALL  STOP AP ( NOL I NE *NS AMP, ARRAY, TOP* DRUMAD) 

READ  IN  STaT  file 

100  IF  (STATKY  ,E0.  0 ) go  to  200  ' 

CALL  PEDSAV(AWPAY,T0P,HMFLG) 

GTASI7  = (VAPS/?  ♦ NOFET2)  ♦ NOSUB2 
STADRS  = DRIt'^An  ♦ TOTPIX 

call  RWH J TE (ST ADWR, APOAY (COVAP2) ,STASIZ,ISTAT) 
im  IF  (istat  .ED.  1)  GO  TO  no 

PEAO  IN  OOTFIL 


200 

C 


IF  (HOTKEY  ,FQ.  0)  RETURN 

TOTSTO  = TOP  - COVAR? 

IF  (TOTSTO  .OF.  LIMIT)  60  TO  220 


LOOOlO 
L00020 
L00030 
LOOOAO 
L00050 
L00060 
L00070 
L00080 
L00090 
LOOlOO 
LOOilO 
LOOifO 
L00130 
LOOUO 
LOOISO 
L00160 
L00170 
FIL00I80 
FIL00190 
F1L00200 
L00210 
L00220 


FIL00230 


>40 

*50 


[1:881 
IL00260 
FIL00270 
FIL00280 
FIL00290 
FIL00300 
FIL00310 
FIL00320 
FIL00330 
FIL00340 
FIL00350 
F1L00360 
FIL00370 
F1L00380 
FIL00390 
FIL00400 
FIL00410 
FIL00420 
riL00430 
FIL00440 
FIL00450 
FIL00460 
FIL00470 
FIL00480 
FIL00490 
F1L00500 
F1L00510 
FIL00520 
FIL00530 
FIL00540 
FIL00S50 
FIL00560 
FIL00570 
FIL00580 
FIL00590 
FIL00600 
FIL00610 
FIL00620 
FIL00630 
FIL00640 
F1L00650 
FIL00660 
FIL00670 
FIL00680 
FIL00690 
FIL00700 
F1L00710 
FIL00720 
FIL00730 
FIL00740 
F1L00750 
F IL00760 
F1L00770 
FIL007B0 
FIL00790 


3^9 


Far:  FILEPO 


WPTTF(f.210)  ... 

21ft  fobmatc  not  enough  core  to  store  dotfilo  - 

CALL  CMERH 
^ ?2ft  TVPSWT  ■ 3 

CALL  ROnOTSJ  ARRAY (COVAR2)  ,OOTVECtTOTOT3.TYPSii»T.SIZE*TOTOT2»NOCATf 
1 CATNAy.NOFFAT,FETVEC*NOFET3.FETVC3*NOSUN,ANGLE»NOFLO* 

? TOTVRT.FLDSAVtVEHTX. DUMMY) 

CALL  WRTFLf)(FL0SAV.VERTX.N0FL0t2*CATNAMf0UHMY) 

TARADR  a STAORS  ♦ - ( VARS22*N0FEAT) *NOSUB2 
MAPAOP  a TABADR  ♦ N0SU82*T0T0T2 

TOTAL  a MAPADR  . . 

FLOADR  a TOTAL 

IF  (MIX  .F(^.  0 .AND.  COND  .EQ.  0)  GO  TO  222 

FLOAOR  r TOTAL  ♦ (NSAMP-llft) *NOLINE  - . 

IF  ( FLOAOP  ,LT.  TOTAL)  FLOADR  « TOTAL 
tOTAL  = FLOADR 

2?2  IF  (DSPKEY  .EO.  0)  60  TO  225 
VTXAOR  a TOTAL  ♦ 4*N0FL0 
total  = VTXAOH  ♦ T0TVRT»2 
C 

2?5  CONTINUE 

IF  (TOTAL  ,LE.  (ORUMAO*ORMWOS) ) 60  TO  230 
WRITE (ft, 400) 

400  FOBMAT(/»  NOT  ENOUGH  CORE  DRUM  SPACE  OF  CLUSTER  MaP  INFO*) 

23ft  CONTINUE 


RETURN 

C 

END 


r A « 

FIl 

Fll 

F'll 

Fll 

Fll 


FILOOeOO 
FlLOOeiO 
FIL00820 
F L00G30 
F L00840 
FIL00850 
F1L00860 
“TL00870 

kooeso 

FIL00890 
■ L00900 
L00910 
L00920 
L00930 
1L00940 
F L00950 
F1l50960 
F1L00970 
F L00980 
FIL00990 
F LOIOOO 
FlLOioiO 
FILOIOZO 
FIL01030 
F1L01040 
F1L01050 
F1L01060 
FIL01070 
FILOIORO 
FIL01090 
FlLOnOO 


3S‘a 


FILE  KNCA(( 


SURROUriNE  KNCAR(OOTStSUBVECfSUBNOfCATVEC*ITERfTABl»SMTCH» 
• CATNUM,CLUNUM*MEANS»00TSUM) 

LABELS  Br  THE  K-NEAREST  NEIGHBOR  PROCEDURE 

implicit  integer  U-Z) 

REAL  OI§TNC(?50) 

6n  OOI S ( S I ZE ♦ 1 ) « SUBNO ( I ) t SUB VEC ( 60 » 


CATVEC<1) *OOTNAH(?SO) *OdTSUM(60*60) 
CATGRY(60) »OOTCLU<250) 


include  COMHKl*LISt 
INCLUDE  COMHKAtLIST 
INCLUDE  CMPKlStLlST 
include  C0HBK6tLIST 

COMMON/INPORM/NOCLS2.NOSUB?tNOFET2»VARSZ2.TOTVT2»NOFL02f 

• AVAR?,C0VAR2.CLSr02»SUBN02.SUB0S2iFL0SV2.VERTX2* 

• EETVC2«30) .SUBVC?(75) .SUPPTR(7S> •CL5VC2(60) * 

• KEPPTS«60) .N06RP.6RPNAM(60»  *GRPDEX(61) t 

• GRPCHK(61) tGROUPS(12A) 


DIMENSION  HEOl (15) *HE02(15) #0ATE(3) *COMENT( 
EQUIVALENCE  (HEOl (1 ) tHEA0(4) ) . (0  ‘ 


. _ . ENT (15) 

_ ^ __  _ _ . . JATE(l)  .HEADtlZ)  )♦ 

2 (HED2(1)  tHEAD(30))  *(CO“iENTm  tHEAD(A8)) 

COMMON  /LABS/NOCAT. CATNAM(60) vN0CL2*CLSNH2 (60) tN0CAT2tCATNM2 (60) f 
SURRAY (120) tPTR(60) iCATPTR (250 ) »CATOOT ( 500 ) . 
DOTVEC(250) .CONOtMix.PROCtMAPKEYtOOTKEY.STATKY. 
SUNANGtT.NEARST»OIST.NOEEATtFETVEC(30) »OMAPUN«OMAPFI t 
OSAVTPfOSTAFI, NOSUN. AN6I.E(8) .SI2E.TOTOT2.FLDINF (6) * 

CLSSYH(62)  .STADRS.MEANAO.TABADR.MAPAOR.SUNCOROO)  . 
OOOTUN.ODOTFI .MANSTA.MANDOT.OSPUNT.DSPFIL.DSPKEY.PRNSTS. 
PRNDOT.FLDNAM. vertex (22) »N0VRT»NSUN.ANGLES(8) 
.TOTDTl.FLnACR.VTXAOR 

COMMON/GLORAL/HEAO(63) .MAPTAP.DATAPE.SAVTAP.flHFlLEiBMKEY. 

HISFIL.HISKEY.TRFORH.ERIPTP.ERPKEY.MAPUNT. NOFILE. 
OMUMAD.ORMWOS.PAGSIZ.OATFIL.ST AFIL.ASAV.ASAVFL 
.NHSTUN.NHSTFI .SCTRUN.MaPFIL 
.ootunt.ootfil.nchpas.trnsfl.bmtrfl.histfl.pchunt. 

CRDUNT.PRTUNT.RANOlO 

NO  OF  DOTS  TO  COMPARE 

REAL  MFANS(N0FET2.1) 

DIMENSION  OOTVC2(250) .TIES(250) 

SAVE  OOTVEC 

DO  5 1=1.T0T0T2 

D0TVC2(I)  * OOTVECd) 

FIND  CLUSTER  NUMBER  OF  DOTS  IF  MAP  AVAILABLE 

IF(HAPKEY,EO.O)GO  TO  15 
NSAMPx(FLOINF (5)-FLDINF(4) )/FL0INF(6) ♦! 

DO  12  Isl.TOTDTZ 
ILINE=OOTS(2.I) 

ISAMP=D0TS(1.I) 

PIXAORxORUMAD* (ILINE/FLDINF(3)-1)*NSAMP*ISAMP/FL0INF(6)-1 
CALL  RREAD (PIX ADR, NUMBER. I .ISTAT) 

00TCLU(I)sNUM8ER 

CONTINUE 

IF(SWTCH.EQ.1)G0  TO  6 

IF  (SMTCH  .EO.  0)  WRITE(6.HEA0) 

WRITF(6.10)NEARST 

format (/TAT. 'LAdELING  BY ». 1 3. ‘-NEAREST  NEIGHBOR  PROCEDURE'/) 
KNGHRR  2 NEAWST 
WPITF(<S.llll) 

FORHAT(25x. 'CLUSTER  LABFLING  DETAILS'./) 

WRITE  ((..  1000) 

FORM AT ( 3X. 'CLUS TFR *. 2X. • CLUSTER ' .3X. 'DOT '.AX. 'DOT' . 

1 7X.  'DOT  • ./>X.  'OUT'  ,/,3X,  'NUMBER'  .AX.  • LABEL '.  3X  . 'LABEL ' . 

2 2X. 'NUMBER *.2X. 'DISTANCE '.2X. 'CLUSTER'.//) 

DO  500  Isl.ITFR 


^SENO 


12 

5 


10 


iiii 

1000 


c 

6 


KNEOOOlO 

KNE00020 

KNE00030 

KNEOOOAO 

KNE00050 

KNEOOOAO 

KNE00070 

KNE00080 

KNE00090 

KNEOOIOO 

KNEOOliO 

KNE00120 

KN|00130 

KNEOOlAO 

KNE00150 

KNE00160 

KNF00170 

KNEOOISO 

KNEOOIOO 

KNE00200 

KNE00210 

KNE00220 

KNE00230 

KNE002A0 

KNE00250 

KNE00260 

KNE00270 

KNE00280 

KNE00290 

KNE0030C 

KNE00310 

KNE00320 

KNE00330 

KNE003A0 

KNE00350 

KNE00360 

KNE00370 

KNE00380 

KNE00390 

KNEOOAOO 

KNEOOAIO 

KNE0OA20 

KNEOOA30 

KNEOOAAO 

KNE00A50 

KNE00A60 

KNE00A70 

KNE00A8C 

KNE00A90 

KNE00500 

KNE00510 

KNE00520 

KNE00530 

KNE005A0 

KNE00550 

KNE00560 

KNE00570 

KNE00580 

KNE00590 

KNE00600- 

KNE00610 

KNE00620 

KNE00630 

KNE006A0 

KNE00650 

KNE00660 

KNE00670 

KNE00680 

KNE00690 

KNE00700 

KNE00710 

KNF00720 

KNE00730 

KNF00740 

KNEOO/50 

KNE00760 


^-20 


FILE  KNCAR 


SO 


READ  IN  distances  FROM  DRUM  ONE  CLUSTER  AT  A TIME 
lALL 


55 


57 

60 


C 

8 


8 

C 


70 


80 


8 

C 


90 


100 


c 

c 

c 

1100 


■-0 


i 


REA0(TA81*P1 


*TOTOT2tlSTAT) 


■ 00TVC2(J) 
« OOTS(4.J) 
0(0ISTNC»T0 


TOT2«OOTNAM«OOTVEC> 


J TISTAT  ,EQ.  50 

rARl  ■ TA81  ♦ T0T0T2 

SORT  DISTANCES  IN  ASCENDING  ORDER 

DO  55  J-1.T0T0T2. 

OOTVEC(J)  

DOTNAM(J) 

CALL  ascend 

REINITIALIZE  ARRAYS 

00  60  J>1*N0CAT 
CATGRYJJ)  s 0 
MAX  ■ 0 

00  70  JJsI.KNGHBR 
L s DOTNAH(JJ) 

RETRIEVE  CATEGORY  NO. 

CAT6RY(L)  « CATGRY(L)  ♦ I , 
IF(CAT6RY<L)  .LE.  MAX)  GO  TO  70 
MAX  * CATGRY<L) 

CATNUM  ■ L 
CONTINUE 

CHECK  FOR  A TIC 

IF  (KNGHBR  .EO. 


1)  GO  TO  100 


60  TO  80 

CATGRYtllD)  60  TO  90 


1201 

1200 

1210 

110 

185 

190 


00  80  III=1. NOCAT 
IF  (III  .FO.  CATNUM) 

IF  (MAX  .EU.  ' ■ 

CONTINUE 

NO  TICS  OCCURRCD 

GO  TO  100 

A TIC  OCCURRED  - DECREASE  K-OOTS  BY  1 AND  REPEAT  PROCESS 

KNGHRR  a KNGHBR  - 1 
TIE  » TIE  ♦ 1 
t!ES(TIE)  a KNGHBR  ♦ 1 
GO  TO  57 

ASSIGN  CLUSTER  TO  CATEGORY 
IF  (SWTCH  .EQ.  1)  II  = CLUNUM 
CATVEC(II)  = CATNgM 

PRINT  CLUSTER  INFORMATION 

WRITE(6.1100) II.CATNAM(CATNUM) 

FORMAT (/tSX« I 2tBX« lAA) 

00  no  Jal  .KNGHBR 
K=DOTNAM(J) 

IFulEbn?WRlTE(6ll201)CATNAM(K)  .DOTVEC(J)  .OISTNC(J) 
F0RMAT{1H.,T24»1A«.2X.I3.4X.F7.2) 

IF(J.GT.1>  WHITE  (6. 1200)  CATNAM(K)  .DOTVCCU)  tOlSTNCU) 
FORMAT (23X. 1A4.2X. I 3.4X.F7.2) 
IF(nOTKFY,fc0.1)WPlTE(6»1210)L 
F0RMAT(lH*.T4ft.I2) 
nOTSUM  (INK)  sOOTSUM  ( 1 1 » K ) ♦ 1 
CONTINUE 

IF  (TIE  .EO,  0)  GO  TO  490 
WRITE(6. 185) 
format (/) 

FORMAN23X?’‘A  TIE  OCCURRED.  •. 3X THE  FOLLOWING  DOT(S)  WERE 


KN 

KN 

KN 

KN 

KN 


00790 
00800 
^00810 
KNEQ0825 
KNC00830 
008AO 
00850 

iin 
00880 
00890 
00900 
00910 


KN 

KNI 

KNI 

KN 

KN 

KN 

KN 

KN 


KNE00920 
KNE00930 
KNE009A0 
KNE009S0 
KNE00960 
KNE00970 
KNE00980 
KNE0099C 
KNEO  00( 
KNEO  ■ 
KNEO 
KNEOl  . 
KNE01040 
KNEO  ■* 
KNEO 
KNEO 
KNEO 
KNEO  ,( 
KNEO  . 
KNEO  , 
KNEO  1 
KNEO 
KNEO 
KNEO 
KNEO  .] 
KNEOl. 
KNEOl 
KNEO  , 


90 


KNE01200 
KNEOl  “ ‘ 
KNEO 
KNEO] 
KNEO 

KNEOl _ ^ 
KNE01260 
KNE01270 
KNE01280 


KNEO 

KNEO 


1290 

300 


KNE01310 

KNE01320 

KNE01330 

KNE01340 

KNE01350 

KNE01360 

KNE01370 

KNE01380 

KNE01390 

KNEOIAOO 

KMF01410 

KNE01420 

KNE01430 

KNE01440 

KNE0i450 

KNE01460 

KNE01470 

KNE01480 

KNEni490 

KNE01500 

KNE01510 

OISCAROKNE01520 


FILE  XNCAft 


18  200  JJil.TIE 
J ■ TtES(JJ) 

K ■ OQTNAM(J) 
,»OOTCLU(OOt 


L»OOtCLU(OOTVEC<J)) 

WRITE (6*1200) CATNAMtK)*OOTV|C(J)*OISTNCCJ) 
IF(OOTKEY.EQ.1>WRITE(6»1210)L 


200  CONTINUE 

KN6HBHsKNQHBR*TIE 


490  CONTINUE 
IF  (SwfCH 


•NE. 

RESTORE  OOTVEC 


1)  60  TO  SOO 


210 
500  JO 


J«l*TOTOT 
(J)  • OOTVC 

(SwVIh  .EQ.  1) 


(J) 

RETURN 


WRITE  DOT  SUMMARY 


1305 

1330 

1310 

550 

1320 

600 

602 

1350 


1340 

610 


^50 


WRITE(6*222< 
format  I iHi*; 


ox* 'CLUSTER  LABELING  SUMMARY* •/) 


WHIT«:(6*1300) 
format (3X**CLUSTER**20X*'NUMBER  OF  DOTS  USED 
ISTRTsl 
IENO«NOCAT 

IF(IENO.GT.IS) lENDalS 
WRITE(6.1305) 

format (3X. 'NUM8ER»*3X* 'LABEL •*7X*50(IH-) ) 
WRITE(6tl330) 


(BY  CATEGORY 


KNEO] 
KN|0 
KNEO] 
KNEO 
KNEO 
KNE 
KNE 
KNE 
KNE 
KNE 
KNE 
KNF 
KNE 
KNE 
KNE 


KNE 
KN| 
KNE 
KNE 
KNE 
KNE 
KNEO 
KNEO 
NAME) ')KNE0 
KNEO] 


format (1H*,T20» 'TOTAL*) 

WRITE (6. 1310) (CATNAM(IJ),1J»1*IEN0) 
FORMAT(30X«1A4*14(3X*IA4) ) 
rin  600  1«1*1TER 
TOTALaO 

00  550  J=l*NOCAT 
TOTAL=TOTAL*OOTSUM(I*J1 
KsCATVEC(I) 

WRITE (6*1320) I*CATNAM(K) *T0TAL* (OOTSUM ( 1 * J) * J>1 * lENO) 
F0RHAT(//*5X*I2*6X*1A4*I5*2X*1S(2X*15) ) 

continue 

IF ( IENO.EO.NOCAT)GO  TO  650 
ISTHTalENO*! 
iENDsNOCAT 

!F(IEN0.6T.ISTHT*14) IEN0aISTRT'l4 
WRITE (6*1350) 

format (//) 

WRITE(6*1300) 

WKITE(6*1305) 

WRITE (6* 1310) (CATNAM(IJ)*IJsISTRT*1END) 

DO  610  1=1. ITER 

WRn£('’*lUo)  I*CATNAM(K)  * (DOTSUMd*  J)  , J»ISTRT*1EN0) 
FORMAT (// *5X* I2*6X * 1 A4* 7X. 15 (2X* 15) ) 

continue 
GO  to  602 

GROUP  LABELED  CLUSTER  ACCORDING  TO  CATEGORY 
K s 0 

DO  510  I«l*NOCAT 
DO  510  Jb1*N0SUB2 

IF  (CATVEC(J)  .NE.  I)  60  TO  510 
SUBNO(I)  s SUBNiT(I)  * I 
K a K « 1 
SUBVEC(K)  > J 

510  CONTINUE 

RETURN 

END 


KNEOIBOO 
KNEOIBIO 
KNEOI820 
KNEOisSO 
KNE01B40 
KNE01850 
KNE01860 
KNE01870 
KNE01880 
KNE01890 
KNE01900 
KNEOiRiO 
KNE01920 
KNE01930 
11940 
KNE0I950 


KNEO] 


n 


KNE019 
KNE019 
KNE01980 
KNE01990 
KN|020( 
KNE020] 
KNE020i. 
KNF.02030 
KNE02040 
KNE02050 
KNE02060 
KNE02070 
KNE02080 
KNE02090 
KNE02100 
KNE02110 
KNE02120 
KNE02f30 
KNE02140 
KNE02150 
KNE02160 
KNE02I70 
KNF.  02 180 
KNE02190 
KNE02200 
KNE02210 
KNE02220 
KNE02230 
KNE02240 
KNE02250 
KNE02260 


L8^2 


non  r»  r»r>or»  n n r\nn  non 


FILCt  LAROOT 


oo 


SURROUTINC  LaROOT(OOTS) 
LABOOT  UPDATES  OOTFIL 
implicit  integer  (A-Z) 


9S 

100 


COMM(|{N^/L*BS/NOci?IcATNAM(ftO»  .NgCL?iCL$NMZ(601*NOCATZ«CATNM?(A0> « 
subbay  C120) .PTR(60l .CATPfS (?50» iCATOQTlSOO} 
nOTvECjPSO) »CONO*MlX«PMOC.MAPKeY«OOTKEVtST 
SyNAN6.TiNFAOST.ftIST,NyFEAT»FFfy£C(30>«0MAPUNsOMAPFI* 
OSAVTP.OSTAF|fNOSuN»ANGI.E(fl)iS!ZF»lOTOI?«FLOIi 


rATKV» 


[NF(6)« 


CLS^YM(6?I ,STAOHS«MEANAD.tAHAOO.MAPADR.|UNCOP(SO) 
OOOTUN.OnOTFI tMANSTA^WANOOT^OSPUNTtnSPFILfOSPKEYtPPNST 
PPNOOT.FLnNA»<,VEMTE*  ( “ ‘ " 


C»EN0 


WANSTA^WANDOTt . . . 

«NOVMT*NSUN« angles (8) 


S« 


»T0T0T3,FL0A0P«VTXA 

DIMENSION  DOTS(SIZEfl)  »CaTN0<60) 

CHECK  CATEGORY  NAMES  FOR  NEW  ENTRIES 

DO  100  I«1»N0CAT2 
DO  90  J«1.*;0CAT 

IF  (CATNM2J1)  .ECi,  CATNAMjjnGO  TO  95 
CONTINUE 

NOCAT  ■ NOCAT  * 1 

INSERT  NEK  CATEGORY 

CATNA*MNOCAT)  ■ CATNM2<I) 

CATNO(I)  ■ NOCAT 
GO  TO  100 

CATNO(l)  » J 

CONTINMF 

00  150  I»1,N0C*T2 

RETRIEVE  BEGIN.  AND  END.  POINTER 


18 

IE 


CATPTH(I)  ♦ 1 
18  ♦ CaTDOKIB- 


1)  - 1 

no  120  J«IB.IE 

RETRIEVE  DOT  NO  AND  CHANGE  CATEGORY  NO  FOR  DOT 

K » CATOOT(J) 

1?0  00TS(4.K)  > CATNC'I) 

ISO  CONTINUE 

return 

END 


LAMOOOAO 

LABOOOSO 

LA800060 

LAPOgOTO 

LA800080 

LAB00990 

LABOOlOO 

LABOOllO 

LABOgiZO 

LAROOlaO 

LAB00140 

tsissUs 

LABOOITO 

LABOOlSO 

LAB00190 

LAB00200 

LA600210 

LABO0220 

LAH00230 

LAB00240 

LABOQZSg 

LAB00260 

labooIto 

LAH00280 

LAB00290 

LAB00300 

LAB00310 

LA0OO32O 

LAe00330 

LAB00340 

LAB00350 

LAR00360 

LAB00370 

LAB003B0 

LA800390 

LAB00400 

LABOOAIO 

LAB00420 

LAB00A30 

LAB00440 

LAH00450 

LAB00460 

LAH00470 

LAB00480 

LAB00490 

LAB00500 

LAB00510 

LAB00520 

LAb00530 

LARO0S40 

I .nnnccn 


3oJ 


ou 


FILE  LABLR 


SUKftOUT INE  L ABLR (ARRAY t TOP t NOFLO « TOT VRT t FLDSAV • VERTX t ME ANS t EX I T T ) 


IKK 


NOFET2*VARSZ2*TOTVT2*NOFLQ2« 
AVAR?.C0VAR2(CL<>I0?*SURN0|*SUeDS2tFL0SV2}VERTX2» 
^STVCPOO)  .SURVC2(T5)  .SUPPTR(TS»  *CL$yC2(60> . 
k|PPTS(60>  «N06RP«6RPNAM(AO) «6RP0EX(6h  » 

COMMON/OLOOAL/MEASVA.Ttlii^TApJnAlAPitSAVTAP.BMFILEfBMKEY* 

^ HibFIL WHISKEY. TRFOHM.ERIPTPfERPKEYtMAPUNTfNOFILE. 

nRUMAO«OHHWOS«PAOS!z«OATFIL*STAFiL»ABAV*ASAVFL 


nRUMAO«OHHWOS«PAOS!Z«OATFIL*STAFiL»ABAV*ASAVFL 
♦NHSTUN.NHSTFl.SCTRUNfHAPFIL 

.OOTuNT»r)ofFlL.NCHPAS»TRNSFL#BMTRFLtM|STFLfPCHUNT# 
CHnUNTtP«TUNT.«*Nf)IO 
COMMON  /LABS/NOC6T,CATNAM(ftO) »NOC 


SUNAN6 


LABS/NOC6T,CATNAM(60).NOCL2.CLSNM2(60» .N0CAT2.CATNM 
SUBPAY  020) ,PTR(60»  jCATPTR (?50) tCATQOT (§00  t 
nOTVFC (?S0» .C0N0»M1X.PR0CiMAPK£Y.0(5TKEY»S  atky* 
.T»NEARST,PIST»N0FFAT,^ETVEC(T0>  »omapun*omapfi» 


CATNM2(00) * 


^SENO 


PRN00T«FL0NAM*VERtEX(?2 

fT0TDT3*FL0A0R*VTXA0R 


ON  FLDSAV(Atl)  •VERTX(2*1>  tARRAYd)  «SUBVEC(60)  •SUSN0S(60) 
ON  N(60l 2CaTVCC(60) *SUBNAM(60) •CNDSUB(60) *HIXSUB(60) 
ANS(NOFFT?.n 


REAL  MEANS(NOFFT?.n 

dimension  00TVC2(?S0) tOOTSUM (60*60) 

DIMENSION  TABLEOnS) 

DATA  BLANK/*  */ 

SMTCH  B 2 

INITIALIZE  OOTSUH 

DO  10  I>1*60 
DO  fo  JbI«60 
nOT£UM(I,J)B0 
CONTINUE 

HANNUALLY  RELABEL  STATS 
IF  (MANSTA  .EQ.  O)  60  TO  20 

CALL  MaNORO(ARRAY(CLSI02)*CLSVC2*SUBVEC*NOCLS2«SUBNOS*NOSUS2) 

UPDATE  INFO  IN  ARRAY 

CALL  REDDER < ARRAY *SUBVEC»N) 

DUTPUT  REOROREO  StATS 

CALL  LA8MAN<OSAVTP,OSTAFI.NOCLS2.NOSUR?.NOFET2,NOFLD2.TOTVT2* 

• FETVC2. AHRAY(FLDSV?) .ARRAY (VERTX2) * ARRAY (CLSI02) • 

• SUBNOS. ARRAY (SUBDS2) .N.STADRS. VARS22. PUNCH. SUBVEC.PRNSTS.SWTCH) 

20  IF  (MANDOT  .EO.  O)  GO  TO  AO 
UPDATE  OOTFIL 

CALL  LABDOT (ARRAY (C0VAR2)) 

OUTPUT  UPDATE  DOTFIL 

CALL  WMTDOT (T0T0T2, NOSUN. FLDSAV. VERTX. angle. ARRAV(C0VAM2) * 

• nocat.catnam.size.nofeat.fetvec.totvht.noflo* 

• OnOTUN.OOOTF I) 

IF  (PWNUOr.EO.l ) GOTO  7R8 
30  CONTINUE 

EXECUTING  A PROOEDURE 


mm 

LABOOOTO 

LABOOOaO 

LAB00090 

LABOOIOO 

LAiooUS 

mm 

ttissm 

laIooiao 

LABOOloO 

LAB0A200 

himm 

LABOO230 

LAB002A0 

LAB00250 

LAB00|60 

LAB00270 

LAB00780 

LAB00290 

LA800300 

LA800310 

LAB00320 

LABOO330 

LAB003AO 

LA8003SO 

LAB00360 

\:mil 

LAB00390 
LABOOAOO 
LABOOAfO 
LAB00A2 I 
LAB00A30 
LAROOAA  I 


LAROOA50 

LABOOA60 

LABO0A70 

LABOOARO 

LABOOAOO 

LAR00500 

LAROOSIO 

LAB00S20 

LAB00S30 

LABOOSAO 

LAR00550 

LABOOS60 

LAR00570 

LABOOSRO 

LAB00S90 

LAH00600 

LAR00610 

LAR00620 

LAB00630 

LA6006A0 

LAB00650 

LAH006A0 

LAB00670 

LAH006HO 

LAH00600 

LAB00700 

LAR00710 

LABO0720 

LAB00730 

LABO0740 

LAB007S0 

LAB00760 


riLC  LABLR 


PROC  • 1 — K-NCARCST  NEIOHBOR 
PRQC  ■ ? — AU.-OF-A-K1NO  _ 
PROC  • 3 — MANUALLY  RELABCL  A 


IF  (PROC  .CO.  3>  RETURN 
HAVE  LABELS  BEEN  OCFINCO 


^ORHA?^*//5/*lix“»iKiSitKoRIES  HAVE  NOT  BEEN  OEFINEO**»*V/» 


SET  UP  OOTVEC  ARRAY 
IF  (T0T0T3  .EO.  0)  60  TO  49 

lit  H»i 

■ .EQ.  I)  60  ■* 


IF  (OOTVEC (J)  .E(i.  I)  60  TO  47 
CONTINUE 
K ■ K • I 

88!?fW^'  ■ ■ 

80  44  I«1«T0TQT2 
^OT^^C(J)  « OOTVCZd) 

CONTINUE 

STORE  FIELD  INFO  ANO  VERTICES  ON  DRUM 

IF  (OSPKEY  .EO.  0>  60  TO  56 

TOTVOS  « 4*N0FLD  . 


CALL  RVRITE(FLOAOR.FLOSAV»TOTwnS»ISTATI 
IF  (1S''AT,.E0.  1)  60  TO  S3 
TOTvts  ■ T0TVRT«2 

CALL  RWRI TE(VTXAOR.VERTX. TOTVTS# ISTATI 

IF  (ISTAT  .EO.  1)  GO  TO  54 

CONTINUE 


READ  MEANS  INTO  CORE  — USE  SPACE  FOR  FIELD  INFO 

MEANl  a STAORS  * VARSZ2*N0SUB2 
TOTVRO  « N0FEAT«N0SUB2 

CALL  RHEAO (MEANl tMEANS.TOTWRO# ISTAT) 

50  IF  (ISTAT  .EG.  i)  60  TO  50 

lERO  OUT  SUHNOS  (WILL  CONTAIN  NO.  OF  CLUSTERS  IN  CATEGORY  I) 

DO  55  I«1#N0CAT 
55  SUHNOS (I)  a 0 

COMPUTE  DISTANCE  TABLE 

CALL  OOTOST(MEANS.ARRAY(COVAR2i *TABLE*LIHIT) 

K-NCAREST  neighbor  PROCEDURE 
IF  ( PROC  .NE.  I)  60  TO  60 


ITER  ■ N0SUH2 
TAMl  a TABAOR 
SWTCH  a 0 


CALL  KNEAR ( ARRAY (C0VAR2J  #SUBVEC#SUBNOStCATVEC# ITERtTABl »SWTCM» 
• DUMMY.OUMMY.MEANStOOTSUM) 

SWTCH  a 2 
60  TO  70 

ALL-OF-A-KINO 

CALL  ALLKIN( array (C0VAR2) .SUBVCC#SU6NOS.CATVEC#MEANS#OOTSUMt 
ASSIGN  APPROPRIATE  NAMES  TO  CLUSTERS 


IaIoIbI 


LABOOB 

LAB00B4 


LAWOOBAO 

timm 

LABOORIO 

\:mm 

LAB0094$ 
LAB00950 
LAB00960 
LASo5970 
LAB0098$ 
LAB00990 
LABOiOOO 
LABO  OIO 
LaIo  020 
LABO  030 
LAB01040 
LAHOIOSO 
LABO  060 
lABO  070 
LABO  060 

LABO  loo 
LABO  iiO 
LABO  120 
LABO  130 
LABO  140 
LABO  150 

mm 

LABO  160 
LABO  190 
LABO^fOO 

LAB^ziS 

LABO  230 
LABO  240 

mom 

LABO  270 
LABO  280 
LABO  290 
LABO  300 
LAB01310 
LABO  320 
LABO  330 
LABO  340 
LABO  350 
LAHO  360 
LABO  370 
LAB01380 
LAB01390 
LAR01400 
LAHOUIO 
LAB01420 
LAB01430 
LAB01440 
LAB014S0 
LAB0U60 
LAB01470 


riLE  LAM.t 


CATNOfNOCAY 

CALC  NAMSrA(«UANAH.CATyeCt 


SU8N0S  f NOSUd?  « C ATNAM  t NOC ATI 


USER  WISHES  TO  EXIT  IF  ANY  CLASSES  NOT  USED  BY  LABEL 


WR1TCIA«10QO)NOCAT«CATNQ 
rORHAT(//»lX*I3t«  LABELS 
CALL  EXIT 


(/^•lXtI3f«  LABELS  REMAININO  OF  t,I3,(.  EXIT  TAKEN') 


OUTPUT  LABELED  STATS 

CALL  LABHAN(0SAVTP.05TAF I, NOCAT. NOSUB?. NOFET2.NOFL02»TOTVT?* 
t ^fI''£2i*'***fT(FLOSV?)  .APPAYfVEPTX?)  .CATNAM.SUBNOStSUBNAM. 

FLAG  CONDITIONAL  CLUSTERS 

CALL  CNOMAP (ARRAY (COVAR?) .CNOSUB.CATVEC) 

OUTPUT  CONDITIONAL  MAP 


CALL  CLSM«P(CN0S'J8.I.SUPN0S* 
90  (HlX  .CO.  0)  00  TO  100 
IF  (CONO.NE.O)  OHAPFI  ■ OMAP 


OS  * SUBYEC . SUBNAM, C AT VEC ) 
MAPFI  * I 


FLAG  MIXED  CLUSTERS 

CALL  MIXMAP(ARPAY(C0VAP?) .HIXSUB.N0SUB2.CATVEC) 

OUTPUT  MIXEO  MAP 

CALL  CLSMAPIMIXSue.B.SURNOS.SUBVCC.SUBNAMtCATVCC) 

OUTPUT  DISPLAY  INTERFACE  TAPE— MAPTAP 

100  IF  (OSPKCY  .EO.  0»  GO  TO  llO 

CALL  R»EAO(FLOAO  l.FLDSAV.fOTwOS.ISTAT) 

103  IF  (ISTAT  .FO,  1)  GO  TO  103 

CALL  hhEAOCVTXAUR.VCRTX.TOTVTS. ISTAT) 

. 105  IF  (ISTaT  .EO.  l»  GO  TO  105 

CALL  pSPTAP(SyBNOS. SUBNAM, FLOSAV.VERTX.CATVEC.SUBVEC.MEANS. 
• ARRAY (C0VAR2) .TOP. AHRAY.NOFLO.TOTVRT) 

s?wir’ 


CODE  TO  PRINT  DOT  DATA  RECORD 


798  CONTINUE 
Tstart.i 
iEND»l0 

799  CONTINUE 
IKT«0 


DO  BOO  II-I.TOTOV? 

JKTefKT*i 

FdEND.GT, NOFEAT)  IENO«NOFEAT 
F( It.NF.l.AN0.IKT.E0.1)WRITE(6,( 
0RM*T(IM1,S(/)) 

IF(IKT.NE.I)  go  TO  820 
WRI TF (6.700) 


700  FORMAT!//) 

WRTTE(6.690) 

490  FORMAT! IX, • NO, '.2X, 'SAMPLE '.2X, 'LINE'. 2X.* TYPE*. 2X.» CATEGORY*. 
I 30X.*OATA*/) 

RRITE(6.7?0) (HLANK.FETVC?(I) . I « ISTART . IENO) 

720  format ( 37X.10IAI. *CH( *.12. • ) •) ) 

820  CONTINUE 


LAB01930 
LABO  9A0 
LABO  950 
LABO  940 
LABO  970 
LABO  980 
LABO  990 
LAB02000 
LA802010 
LAB02020 
LAB02030 
LAB020A0 

tiSIlItl! 

LAB02070 
LAR02080 
LAB02090 
LAB02100 
I AH0?||0 
LAB02I20 
LABO?  30 
LAHO?  40 
LAH021S0 
LAH0?i60 
LAP02  70 
LAB02180 
LABO?  90 
LAB02200 
LAB022I0 
LAH02220 
LABO2230 


FILE  LABLR 


|DUM«C0VAR2* ( 1 |.l ) •SIZE-1 
f 0HMaC0VAR2« ( I I-l ) *SIZE*3 
WRITE («>«710)  II «( ARRAY (10UM*I)«I>1  *4)  , 
*0» 


(ARRAY (IOMM*JJ)«JJ: 

format (IX. I3tlH.t3X*l4«3X* I4t2X» I2*6XtI2*8X« 10 (!3*4X)) 
WRITE(6.7l2i 

712  F0RMAT(  » 

800  CONTINUE 

IF(NOFCAT.GT.IO)  60  TO  830 
60  TO  840 
830  CONTINUE 

IF(ITWO.EO.l)  60  TO  840 
!two«i 

!start«iend*istart 

IEND«NOFEAT 
60  TO  799 
840  CONTINUE 
GOTO  30 
END 


LAR02290 

LA902300 

IISTART.IENLAR02310 

LAHU2320 

LAH02330 

LAH02340 

LAH023S0 

LAH02360 

LAR02370 

LAB02380 

LAB02390 

LAR02400 

LAU02410 

LAB02420 

LAB02430 

LAB02440 

LAB02450 

LAB02460 

LAB02470 


f-! 

'-'4. 


3sr 


ooooo  oori  nor>  noo  o non  noon  onoono  o or> 


FTLF:  MANORD 


HFND 


SUBROUTINE  MftNORO (CLSNAM.CLSVEC*SUBVECtN0CLSZ.SUBN0.N0SU82> 
MANORO  REGROUPS  THE  SUBCLASS  IN  THE  ARRAY  SUBVEC 
implicit  integer  (A-2) 

INCLUDE  CMHKIS.LIST 

common  /LABS/N0CaT,CATNAM(60) ♦NOCLZtCLSNM2(iKO) .NOC AT?«CATNM2 (60) 
subray (1?0) »PTR(60) »CATPTR(250),CATDDT(500)t 
DOTVECJZSO) .com)»mix,proc.mapkfy.ootkey,statky. 

SUN ANR,TtNFARST*nl ST t NOFEAT, FETVEC ( TO) ,0maPUN,0MAPF I , 
OSAWTH.ORTAFl .NOSUN, ANRLF (P) .SIZE.TOTDTZ.FLDINF (6) , 

CLSSYM(62) ,STAnRS,HEANAD,TABA0R,MAPADR,SUNC0R(3n)  , 

ODOTiin.ODOTFI ,mansta,manoot,dspunt,dspfil,dspkey,prnsts, 

PRNDOT.FLONAM, VERTEX (22) ,NOVWT,NSUN. ANGLES (8) 
,T0TDT3,FL0AUR,VTXA0H 


dimension 

DIMENSION 


SUPNO(f)O) 

CLSN0(60) 


.CLSVEC ( 1 ) .CLSNAM ( 1 ) .SUBVEC ( 1 ) 


CHECK  validity  of  CLASS  NAMES 

DO  I = 1.N0CL2 

no  120  J=l,NOCLS2 

IF  (CLSNM2(I>  .FO.  CLSNAM(J))  GO  TO  145 
120  rONTlNIJE 

WRITE (6,130) (CLSnAM(K) ,Krl,N0CLS2) 

nn  F0RMAT(i,  error  in  input  of  class  names,  names  on  stat  file  ape 

• ,(7(A<,.-^X)  / T55  )) 

URITE  (F.,  140)  (CLSNM2(r)  ,Kc1,N0CL2) 

140  F0RMAT(/  « NAHFS  INPUT  ARE  ) •,  ( 1 0 ( A4» 3X ) /) ) 

14S  CLSNOd)  = J 
ISO  CONTINUE 

rearrange  SURVC?  array  so  all  SUBCLASSES  FOR  A GIVEN  CLASS  APE 
GROUPED  TOGETHER 

00  160  I=1,N0CL2 

BEG.  AND  END  PTRS  FOR  SUBRAY 

IB  = PTR(T)  ♦ 1 

IE  = IB  ♦ S')HPAY(IB-l)  - 1 

no  160  J=IB.IE 

STORE  NEW  CLASS  NO  EOR  RELABELED  SUBCLASS 

M = SUBPAY(J) 

160  CLSVEC(M)  = CLSNO(l) 

ZERO  SUBNO  ARRAY 

DO  165  l=l,NOSUB2 
165  SUBNO (I)  = 0 

COMPUTE  NO.  OF  SUBCLASSES  IN  EACH  NEW  CLASS 

DO  170  I=1.N0SUP2 
K = CLEVFCd) 

170  SIJBNO(K)  s SUBNO(K)  ♦ 1 

ORDER  The  SUBCLASS  NOS.  ACCORDING  TO  THE 
NEWLY  ASSIGNED  CLASS  NO  — STORE  IN  SUBVEC. 


<K 

DO 


S 0 

IPO  I = l,r.'OCLS2 


1 AO 


DO  1«0  J=1.N0SUB2 
IE  (CLSVFC(J)  .NE. 
KK  = ♦ 1 

EUPVEC(KK)  = J 
CONTINUE 

RETURN 


I)  GO  TO  180 


O)  i{i:ivAL  PAGE  IS 

Or  POOR  QUALITY 


MANOOOIO 
MAN00020 
MAN00030 
MAN00040 
MAN0C050 
MAN00060 
MAN00070 
MANOOOBO 
MAN00090 
MANCOlOO 
MANOOllO 
MAN00120 
MAN00130 
MAN00140 
MANOOISO 
HAN00160 
MAN00170 
MANOOIBO 
MAN00190 
HAN00200 
HAN00210 
MAN00220 
HAN00230 
M4N00240 
MAN00250 
MAN00260 
MAN00270 
MAN002B0 
MAN00290 
MAN00300 
•MAN00310 
MAtJ003?0 
MAN00330 
MAN00340 
MAN003S0 
MAN00360 
NAN00370 
MAN00380 
MAN00390 
MAN00400 
MAN00410 
MAN00420 
MAN00430 
MAN00440 
MAN004SO 
HAN00460 
HAN00470 
MANU0480 
MAN004R0 
HAN00500 
MAN00510 
PAN00520 
HAN00530 
('AN00540 
MAN00550 
MANOObhO 
K.AN00570 
MANOOSBO 
MAN00S90 
HAN00600 
MAN0061 0 
HAN00620 
MAN00630 
MAN00640 
MANOObSO 
PAN00660 
I^AN00670 
MAN006B0 
mA(<.006<y0 
A N 0 0 7 0 0 
SAN0071 0 
HAN00720 
MAN00730 
•^AN00740 
'••AN007S0 
MAN0076C 
VAN00770 
MAN007B0 
*■*61.00790 


PILE;  MANOPO 
C 

ENO 


MANooeoo 

MANOOSIO 
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UOUOOUUOOO  UU  <JUU 


FKEl  MAPHNO 


this  routinf  prints  th€  header 

MAP  IN  classify  AND  DISPLAY 


information  for  The  classification 


SURROUTINE  MARHND(NOCATtCLSSYM,CATNAM,KATNO»SUBOEStCATSUB) 


nocat 

CLSSYM 

CATNAM 

K4TN0 

CLSMTX 

StJRAJO 

SURDFS 

CLSVC? 


SUBCLASSES 
TO 


NO.  OF  CATEGORIES 
SYMBOLS  FOR  CATEGORIES  OR 
CATEGORY  NAMES 

CATEGORY  EACH  CLASS  WAS  ASSIGNED 
CLASS  NAMES 
NO,  OF  SUBCLASSES  IN  EACH  CLASS 
SUBCLASS  NAMES 

CLASS  FACH  SUBCLASS  WAS  ASSIGNED  TO  (IN  COMMON 
BLOCK  INFORM) 


SEND 


IMPLICIT  INTEGER  (A-Z) 

INCLUDE  COMskulIST 

COMMON/ 1 NFORM/NOCLS2.  NOSUB?  »NOFF.T?»VARSZ2*TOTVTZ»NOFL02* 

» AVAR2.COVAR?,rLSID2,SURNO?,SUBOS2.FLOSV2*VEHTX?* 

» FETVC2O0)  .SUHVC?(7S>  .SUHPTR(75)  »CLSVC2(60>  • 

► KEPPTSInO) .NOGRP.GWPNAM(60) tGRPOE* (6l) » 

» r,KPCHK(M)  .groups  (124) 

LOGICAL  ISwTh 

dimension  CLSSVM(I)  .CATNAM(I)  ,KATN0(1)  .SUBDESd) 
dimension  CaTSUB(I) 

PRINTS  CATEGORY  CLASSIFIER  INFORMATION 


200 


C 

c 


210 


G4 


260 

7? 
24  0 

7R 

PO 

f>3 

6P 


MAPDOOlO 
MAP00020 
MAP00030 
MAP00040 
MAPOOOSO 
MAR00060 
MAP00070 

mapooobo 

MAP00090 
MAPQOlOO 
MAPOOIIO 
MAP00J20 
MAP00130 
MAP00140 
MAP00I50 
MAPOJI60 
MAP00170 
MAP00180 
COMOOOlO 
CUM00020 
COM00030 
COM00040 
COM00050 
MAPOOlOO 
MAP00210 
MAP00220 
MAP00230 
MAP002A0 
MAP00250 
MAP00260 
MAP00270 

WRTTP (4.2001  ■ MAP002H0 

FOOMftT (//T5A, »|  aBFLED  CLUSTER  MaP*//T49.'(  **  - DENOTES  MIXED/CONOMAP00290 
cluster  1»/TS0,‘  m - DEMOTES  DU/OU  AREA*.  QX, • I *///T33» *LA«EL* • MAR00300 
T«1 , 'SUBCI.AS6*/T31 ♦ *NO. • . T36. • NAME • » T64 . 'UNLaBELEO  NO.* .TPO,  maP00310 

- - - . MAP00320 

MAP00330 
MAP00340 
MAR00360 
MAP00340 
MAP00370 
MAR00380 
MAP00390 
MAP00400 
MAP00410 
MAP00420 
MAP00430 
RAR00440 
MAP00450 
MAP00460 
maP00**70 
MAP00480 
MAP00490 
MAPOOSOO 
MAP00510 
MAR00520 
MAP00530 
MAP00540 
MAPOOSSO 
MAP00S60 
MAP00670 


« 

* 

♦•LABFLEi*  NO.*  ,T9a. 'NAME*  .T  101  i 'SYMBOL  • ) 


,)J  = 0 
KK  = 0 
DO  69 


1=1. NOCAT 


WPITF(4,?10) I.CATNam(I) 
F0PMAT(/T31.I2.T37.A4) 

ISWTH  = .TRUE, 
no  63  J=).N0SUB2 
IF  (KATNO(J)  .FO.  1)  GO  TO  64 
GO  TO  63 

IF  TiswTH) 'go  to  72 

WPTTF(6.2S0) J.KK.SURDES(KK) .CLSSYM(J) 

FOR  ■'AT  ( T6R.I2.T84.I2.T94,A4.T105.A1) 

GO  TO  76 

WRTTE (6. ?i0) J.KK, SURGES (KK) .CLSSVM(J) 

FORMAT ( IH*.T6R. I2.T84,I2.T94.AA,riOS»Al) 
IS-<TH  = .FALSE. 

IF  (CATSUH(J)  ,GT,  (NOCAT  ♦ 21)  WRITE(6»aO) 
format  < lh*.T92»2h**) 

CONTINUE 

CONTINUE 

RETURN 

END 


ooo  o or^onooo  o or»r»  net  nrtrt 


FRF 


MIXMAP 


? 

C 


ijend 


90 


SUBROUTINE  MIXMAP(D0TStMlXSUBtN0SUB2«..ATV£C) 

FLAGS  THE  MIXED  CLUSTERS 

IMPLICIT  INTEGER  (A-Z) 

INCLUDF  C0MPK6.LIST 
TNCLllOF  CM*J'<!S.LIST 

C0MM0N/GL0BAL/HEA0(6T) .MAPTAPtOATAPEtSAVTAP.BMf ILE.BMKEY. 

HlSFlL.HISKfY.THiFONM,ERIPTP*ERPKFy.MAPUNT*NOFlLFt 
DPUMAOtOPMWDS.PAGSIZfOATFILfSTAFlL. ASAVtASAVFL 
»NMSTlJN»NH5TFItSCT9UN»MAPFlL 

.DOTUNT.OOTFIL.NCHPAS»TRNSFL*BMTRFL»HISTFLfPCHUNT. 
rPDiINT  ,P9TUNT,Pa\0I0 

COMMOfJ  /LABS/NOCAT«CATNAM(ftO) .NOCL?.CLSNM2<ao) .N0CAT?»CATNM? (60) « 
SUH9AY (120) tPIP(60) .CATPT9(?S0) .CATOOT (SOO) « 
D0TVEC(?‘^0)  fCOND»HlX»PKOC.MAPKFY»DOTKEY»STATKY* 
SUHANG.T»N'FAPST*OlSTtNOFFAT*FETVFC  < ^0)  .OmaPUN.OMAPFI  , 
OSAVTPtOSTAFI ,N0SUN,AN6LF (H) »SIZF»TOTnT?,FL01NF (6) « 

CLSSYm(62)  tSTAOr.S»MEANAD»TABAOR«MAPAOP»SUNCORI30)  • 
OOOTUN»OnOTFI .MANSTA,MANDOT.OSPUNT.nSPFIL.OSPKEY*PRNSTS* 
PPNnOT.FLHNAP, VERTEX (22) ,NOVHT»NSUN, ANGLESCB) 
»TnT0T3,FL0A0R.VTXA0R 

dimension  D0TS(SIZE*T0TDT2) ,mIXSU8(1) *CLSTNO(250) 

DIMENSION  CATVFC(l) 

initialize 

no  90  I=1.N0SUP2 
MIXSUH(I)  = CATVEC(I) 


NSAMP  = (FLDINF(5)-FLDINF(4) )/FLDINF(6)  ♦ 1 

MEYT  = 43 

no  ino  I=l.T0TnT2 

ILINE  = nOTS(2«I) 

ISAMP  = DOTS (1. I) 

piyaor  = OHiiMAn  ♦ (iline-i)*nsAmp*isamp-i 

CALL  RREAD(PIXADR.NUMpER»l.ISTAT) 

110  IF  (ISTfiT  1)  60  TO  110 

100  CLSTNO(I)  = NUMBER 

CL9TN0  CONTAINS  THF  CLUSTER  CLASSIFICATION  NUMBER 
MIXStlB  FLAfiP  THE  MIXED  CLUSTER 

CATVFC  CONTAINS  THE  LA8ELF0  CATEGORY  NUMBER  PER  CLUSTER 

ARE  ALL  DOTS  wIThIN  A CLUSTER  OF  THE  SAME  LABEL 

no  ISO  I=l»NOSUB2 
K = 0 

no  140  J=l,TOTDT2 

IF  (CLSTNO(J)  .NE.  I)  GO  TO  140 

K s K ♦ 1 

IF  (K  ,LE.n  GO  TO  130 
CATNUM  = 00TS(4*J) 

GO  TO  lAO 

130  CATNRR  = D0TS(4.J) 

IF  (CATNBR  .FO.  CATNUM)  GO  TO  140 


FLAG  CLI.'STER  AS  MIXED 

NEXT  = NEXT  - 1 

MIXSUR(I)  = NEXT 
GO  TO  14(1 
140  CONTINUE 
ISO  CONTINUE 

return 

END 


ORIGINAL  PAGE 
OF  POOR  QUA  MTV 


MIXOOOlO 

HIX00020 

M1X00030 

M|X00040 

M1X00050 

MIX00060 

M1X00070 

MIXOOOBO 

MIX00090 

MIXOOIOO 

MtXOOllO 

M1X00120 

MIX00130 

Mjxoouo 
MIXOOISO 
M1X00160 
MIXOOlTO 
MIXOOIBO 
M1X00190 
M1X00200 
MIX00210 
MIX00220 
MIX00230 
MIX00240 
MIX00250 
M1X00260 
M1X00270 
MIX002SO 
MIX00290 
MIX00300 
MIX00310 
M1X00320 
KIX00330 
MIX00340 
M1X00350 
MJXOOSGO 
MIX00370 
MIX00390 
MIX00390 
M1X00400 
MIX00410 
MIX00420 
MIX00430 
M1X00440 
MIX00450 
MIX00460 
MIX00470 
MIX004BO 
MIX00490 
MIXOOSOO 
MIXOOSIO 
M1X00520 
MIXOObSO 
MIXOOS40 
MIX005S0 
MIX00560 
MIX00S70 
MlXOObSO 
MIX00S90 
M1X00600 
MIX00610 
MIX00620 
MIX00630 
Ml  AU0640 
M]  XOO&SO 
MI xOObbO 
HI  X00670 
MI  XOOSAO 
M1X006R0 
Mixooroo 
MI  *007 10 
MIX00720 


OOOrtO 


FlLFt  «C00ER 


i 

C 

C 


csEwn 

e 

c 

100 

no 


SUflPOUT 1 nE  PEOhES ( ARP  a Y ♦ SUfl VEC  » N ) 
REORDER  10  INFORMATION  IN  ARRAY 


IMOLICIT  integer  (A-Z) 

INCLUOF  COMORI.LIST 

COMMON/lNFORM/N5CLS2fNOSOR?fNOFET2«VARSZ2»TOTyT?.NOFLn2. 


•' 


*VAR2.C0VAR?»CLS102tSURN02.SUPDS2*FL 0SV2.VERTX2* 
FfTVC2(30) »SUHVC2(75) .SUHPTR(75) *CL$VC2(60) » 
KFPPTS(0'Jl  .NOG«R»GkPNAM(60)  »6RP0EK(61)  » 
0RPCrfK(61) »GR0UPS(12A) 


DIMENSION  APRAY(l) «SUBNAH(60>*N<1) 
DIMENSION  SORVECU) 

UPDATE  SUBCLASS  NAMES 

DO  100  l«lt^'OSUB2 
K » SUPVECm 

SURNAM(I)  3 ARRAY (SU0OS2  ♦ K-1) 

DO  110  I»1.'»0SUB2 
ARRAY(Suei)S2  « 1-1)  s SUBNAM(I) 


UPDATE  POPULATION  ARRAY 

DO  no  IsUN0SUB2 
K * SUBVEC(T) 
no  N(T)  X KEPPTS(K) 

RETURN 

END 


REOOOOlO 

RtOOOOPO 

RF000030 

REOOOOAO 

NEOOOOSO 

RE000060 

COHUOOlO 

COM00020 

COM00030 

comoooao 

COMOOOSO 

REOOOOBO 

RFOOOOOO 

REOOOlOO 

REooono 

pEOOono 

RE000130 

REOOOIAO 

RE000150 

RE000160 

RfcOOOlTO 

REOOOlftO 

RE000190 

PF000200 

PE000210 

RFOO0220 

RE000230 

R1000240 

REU00250 

Reo002N0 

WEOO0270 

PEO002P0 

RE000290 


JJ-32 


no  o noon 


FILE  SETU 


i: 

c« 


SEND 


SUBROUTINE  SETl4(ARRAYfT0PfCXIT> 

SET  14  READS  IN  THE  CONTROL  CAROS  FOR  THE  LABEL  PROCESSOR 
IMPLICIT  INTEGER  (A-Z) 

DIMENSION  CODE  <2l)«  CARD  (62).  EQUCOM  (3) 

DATA  CODE  / »CHANt.  .DATA*.  »MAPF*.  «DOTF».  *OPTP.  «EXCL». 

• »STaT'.  »00TL'»  'STAL*.  *nlST'»  *TMRE*»  ‘NEAR*.  *PROC».  •MODU't 

• *SUNA«.  tMAPT*.  'DATE*.  ‘COMM*.  •HEOl*.  •HE02*.  ••ENQi  / 

IN  THE  CONVERSION  FROM  U08  TO  IBM.  STATLA  BECOMES  STAL 

DIMENSION  ARRAY (1) .ACAPD(20) 

DIMENSION  SLASH(2) .EOUVECI2) 

DATA  SLASH/1, »/!/ 

DATA  EOUVEC/l.'s*/ 

DATA  EUUCOM/2, 

DATA  COOEl/*  •/ 

INCLUDE  COMBKl.LIST 
INCLUDE  C0MHK4.  LIST 
INCLUDE  COMBKb.LIST 
INCLUDE  CMRKIS.LIST 

COMMON/ INEORM/NOCLS2.NOSUB2.NOEET2.VARSZ2.TOTVT2.NOFL02. 

• AVAR?.C0VAR2,CLSI02.SURN02.SU80S2.FLDSV2.VERTX2. 

• EETVC2(?0) .SUHVC2‘75) .SUPPTR(75) .CLSVC2(60) . 

• KEHPTS(60) .NO6RP.GRPNAM(60) .6RP0EX(61) » 

• GHHCHK (61) .GROUPS (124) 

DIMENSION  HEOl  (IS)  ,HED2(  IS)  .DATE  (3)  .C0MENTU5) 
equivalence  (HEul (1 ) .HEAD (4) ) . (DATE (1) .HEAD (22) ) . 

2 (HEO?(l ) .HEADOO)  ) , (COHENT  (1)  .HE AO (48)  ) 

C0MM0N/GL0HAL/HFaD(63) .MARTAP.DAT APE »S A VTAP.BMFILE.BMKEY. 

H ISK IL. H 1 SKEY.TRFOHM.ER IP  TP, ERPKEY.MAPUNT. NOFILE. 

orumad.ormwds.pagsiz.oatfil.stafil.asav.asavfl 
,nhstun,nmstfi .sctrun.mapfil 

,dotunt,dotfil.nchpas,trnsfl.bmtrfl.histfl.pchunt. 

crdunt.prtunt.randio 

COMMON  /LAhS/NOCAT.CATNAM(60) .NOCL2.CLSNM2 (60) .NOCAT2.CATNM2(60) . 
SUBFAY(IPO) ,PT«(60) ,CATPTR(2S0! .CATOOT(500) . 

OOTVEC (2S0) .COND.MIX.PROC.MAPKEY.DOTKEY.STATKY. 
SUNANG.T.NEARST.DIST.NOFEAT.FETVEC (30) .OMAPUN.OMAPFI. 
OSAVTP.OSTAF I , NOSUN, angle (S) .SI7E.T0TDT2,FLDINF (6) . 

CLSSYM(6?) ,STADRS,mEANAO,TABADR,MaPADR.SUNCOR(30)  . 
0D0TUN,0U0TPI .MANSTA,MAN00T,0SPUNT.DSPFIL.0SPKEY»PRNSTS. 
PRNDOT.FLONAM, vertex (??) ,N0VRT.NSUN,ANGLES(8) 

,totdt  ).floaor,vtxadr 


REAL  T,SUNC0R 
DATA  BLANK  / • •/.  SBCD 

• FRCD  /'F'/,  IHCU  /•!•/, 

• Mf'CO  /'Ml/,  HCDI  /♦!•/. 
DATA  E0CO  /•£•/ 

initialize  parameters 


/ 'S*/,  08CD  /«D*/.  UBCD  /"Js/. 

0«C0  /'O'/.  COMMA  /•,»/,  CBCO  /*€»/. 
BC02  /»2'/.  Ki CO  /'K*/,  A8C0  /'A*/ 


nput 
T0T0T3 
COND 
MIX 
PROC 
PRNOOT 
PRNSrS 
mansta 
mandot 
MAPKEY 
OOTKEY 
OSPkEY 
STATKY 
NOSUN 
SUNANG 
T 

NEARST 
OIST 
NOFET? 
NOFEAT 
PTfll 
PTR?  =0 
NDCAT2  = 
NOCL?  -=0 
F.XIT  = 0 


21 

0 


= 0 


0 

0 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

2S.0 

1 

1 

0 

0 


OF 


is 


QI-ALW 


SETOOOlO 

SET00020 

SET00030 

SET00040 

SET00050 

SET00060 

SET00070 

SFT00080 

SET00090 

SETOOlOO 

SETOOllO 

SET00120 

SET0013Q 

SET00140 

SET00150 

SET00160 

SET00170 

SET00180 

SET00190 

SET00200 

SET00210 

SET00220 

SET00230 

5ET00240 

SET00250 

SET00260 

SET00270 

SET002R0 

SET00290 

SET00300 

SET00310 

SET00320 

SET00330 

SET00340 

SET00350 

SET00360 

SET00370 

SET00380 

SET00390 

SET00400 

SET00410 

SET00420 

SET00430 

SFT00440 

SET00450 

SET00460 

SET00470 

SET00480 

SET004RO 

SET00500 

SETOOSIO 

SET00S20 

SET00530 

SETOOS40 

SEfOOSSO 

SET00S60 

SET00570 

SET00580 

SET00S90 

SET00600 

SET00610 

SET00620 

SFT00630 

SET00640 

SFT006S0 

SET00660 

SET00670 

SFT00680 

SET00690 

SET00700 

SET00710 

SFT00720 

SFT00730 

SFT0D740 

5ET007S0 

5ETU0760 


3iy 


onn  or»o  ooo 


FILE  SETU 


CLSVCZd)  I 
SUBPTH(75) 


BLANK 
* BLANK 


DO  20  I>1*30 
20  SUNCOR(I)  > 1.0 
WRTTE(6.100) 

100  F0RMAT(/11X. •INPUT  SUMMARY*//! 


105 

107 


US 


130 

135 

140 


PUT  THE  NEXT  CARO  IN  THE  REREAD  BUFFER 
RRUNIT*30 

READ (21 .107) (ACAPD(I) tl>l«20) 

FOWMAT(20A4> 

WRITE  (30.107)  (ACARDU)  »I>lf20) 

REWIND  HRUNIT 
PEAD(30«110)CODE1*CARO 
REWIND  RRUNIT 
COLs  0 

WRITE (6. 120) COOEl. CARO 
FORMAT  (A4*  6X.  62A1) 

FORMAT  (IX.  A4.  6X.  62AD 

’^IF(COnElTEol!cOUE(in  goto  dsg.lflo. 210. 250.330. 365.370. 

* 390.400.410.420.430.440.460.470.490.510.530.540.550.560)  . I 

CONTINUE 
WRITE(6.140) 

FORMAT!  • INVALID 
GO  TO  105 

CHANNEL  CARO 


CONTROL  CARO  - IGNORED  •) 


150 


153 

155 

160 


170 


MsNXTCHR(CARO.COL) 

105 

IF 

(M 

.EO. 

BLANK) GO 

TO 

IF 

(M 

.F(), 

shcd)  go 

TO 

160 

IF 

(M 

.EO. 

DBCD)  60 

TO 

170 

WRTTE(6.155)  , , 

FORMAT!  * ERROR  ON  CHANNELS  CARD*) 

GO  TO  105 

J = FINU12(CAR0.C0L.E0UC0M) 

IF  ( J .NF.  ? ) GO  TO  153 

N0FET2  = NijMRER  (CARD. COL. FETVC2.N0FET2) 
COL  s COL  - 1 
CALL  ORDER (FETVCP.N0FET2) 

GO  TO  150 

J = FIND12(CAHn.COL.EQUCOM) 

IF  (J  .NE.  2 ) GO  TO  153 
NOFEAT  = NUMflER(CARD. COL. FETVEC. NOFEAT) 
COL  = COL  - I 
CALL  ORDER(FETVEC. NOFEAT) 

GO  TO  150 

DATA  FILE  CARD 

180  M = NXTCHH(CARD.COL) 


185 

187 

190 


IF 

(M 

.EO. 

RL4NM 

IGO 

TO 

105 

IF 

(M 

.EO. 

UmCD) 

GO 

TO 

190 

IF 

(M 

.EQ. 

FBCD) 

60 

TO 

200 

200 


WRITE(6.187)  . . , . 

format (•  ERROR  ON  DATA  FILE  CARD*) 
GO  TO  105 

J = FIN012(CARD.C0L.E0UC0M) 

IF  (J  .NF.  2)  GO  TO  185 
M = NUMBER (CARO. COL. OATAPE. ZERO) 
COL  = COL  - I 
GO  TO  180 

J = FIND1?(CARD.C0L.EQUC0M) 

IF  ( J ,NF.  2 ) GO  TO  185 

M = NUMBER (CARD. COL. DATFIL. ZERO) 

OATFIL  = DATFIL  - I 

COL  = COl  - 1 

GO  TO  180 

CLUSTER/CLASSIFICATION  MAP  TAPE 


SET00770 
SFT00780 
SET00790 
SET00800 
SETOOSIO 
SET00820 
SET  00830 
’lT00840 
.iT00850 
SET00860 
SET00870 
SET00880 
SET00890 
5ET00900 
SET00910 
SET00920 
SET00930 
SET00940 
SET00950 
SFT00960 
SET00970 
5FT00980 
5ET00990 
SETOIOOO 
SETOlOlO 
SET01020 
SET01030 
SET01040 
SET01050 
SET01060 
SET01070 
SET01080 
SETOI090 
5ET0I100 
SETOlllO 
SFTOII2O 
SET01130 
SET01140 
SET01150 
SFT01160 
SE701170 
SETOllBO 
5ET01190 
SET0120C 
5ET01210 
SET0122U 
SET01230 
5ET01240 
5ET01250 
5ET01260 
SET01270 
SET01280 
SET01290 
SET01300 
SET01310 
5ET01320 
5ET01330 
5ET01340 
5ET01350 
SET0I360 
SET01370 
SET01380 
SET01390 
SET01400 
SET  014  10 
SET01420 
SET01430 
SET01440 
5FT01450 
SFT01460 
SET01470 
SFT01480 
SFT01490 
SF  TO  1500 
SET01510 
SET01520 


FILF  SETU 


111 


III 

F13 

214 


0 H > NXTCHH<CARO<COU 

: (M  .EU.  IHCD)  60  TO  ZIJ 
F (H  .EO.  QHCU)  60  TO  2Z| 
(M  .E6.  BLANK >60  TO  lO! 


222 


f 

C 


WRITE(6«216) 
FORMAT (•  ERROR  ON 
60  TO  105 


MAPFIL  CARD*! 


► 214 
ro  215 
TO  211 


215 


220 

221 


MARKET  » 1 

M « NXTCHH(CARO*COU 

IF  (M  .EU.  C0MMA)60 
F (M  .EQ.  FHCD)  60 
F (M  ,NE.  UHCO)  GO 
J » FlND12(CAR0tC0LfEQUVEC» 

IF  (J  .EO.  -1)  60  TO  212 
M s NUMHER(CARO*COL»MAPUNT»ZERO) 
COL  » COL  - 1 
GO  TO  214 

J r FIND12(CARO.COL»EOUVEC> 

IF  (J  .Eti.  -n  60  TO  212 

M s NUMRER<CARD*COL»MAPFIL»ZERO) 

COL  * COL  - 1 

MAPFIL  = MAPFIL  - 1 

60  TO  214 

J e FlND12(CARntC0L. SLASH) 

IF  (J  .to.  -1»  60  TO  212 
M = NXTCHR(CARPiCOL) 


IF  (M  ,EQ.  C0MMA»P0  to  221 
IF  (M  ,EQ.  FRCD»  go  to  222 
IF  (M  ,NE.  UBCD) 


250 

251 


252 

253 


254 

256 


. GO  TO  211 

J = FlN012(CARDtC0LtE0UVEC) 

IF  (J  .EO.  -1)  60  TO  212 
M = NUMBER (CARD. COLfOMAPUN. ZERO) 
COL  = COL  - 1 
60  TO  221 

J a FIN012(CAH0.C0L.EQUVEC) 

IF  (J  .EO.  -1)  GO  TO  212 

M a NUMhEH(CAH0»COL»0MAPFI.ZER0) 

COL  X COL  - 1 

OMAPFI  X OMAPFl  - I 

GO  TO  221 

OOTFIL  CARD 

M a NXTCHR (CARD. COL) 


IF 

(M 

.EQ. 

IRCD) 

GO 

TO 

254 

IF 

(M 

.EQ. 

OBCO) 

RO 

TO 

260 

IF 

(M 

.EQ. 

BLANK) 60 

TO 

105 

W«ITE(6.253) 
format (•  ERROR 
60  TO  105 


ON  MAPFILE  CARD') 


258 


260 

262 


J a FlN012(CAR0.r0L. SLASH) 

IF  ( J .EQ.  -1)  GO  TO  252 
DOTKET  a 1 

M a NXTCHR(CARO.COL) 

IF  (M  .EO,  C0MMA)G0  TO  256 
IF  (M  .EQ.  FHCO)  go  to  258 
IF  (M  .NE.  URCD)  GO  TO  251 
J a FIN012(CARD.C0L.EQUVEC) 

IF  (J  .EO,  -1)  GO  TO  25? 

M a NUMWER(CAR0. COL. OOTUNT. ZERO) 
COL  a COI.  - 1 
GO  TO  256 

J a FIM)12(CAPO.COL.EOUVEC) 

IF  (J  .EO.  -1)  GO  TO  252 

M = NUMHER (CARO. COL. OOTFIL. ZERO) 

COL  a COL  -I 

nOTFIL  a OOTFIL  - 1 

GO  TO  256 

J a FIND1?(CAR0. COL. SLASH) 

IF  (J  ,F0.  -1)  (,0  TO  252 
M a NXTCHR(CARG.COL) 


SETO 

1530 

SETO 

SETO 

55(1 

SETO 

560 

SETO 

570 

SETO 

580 

SETO 

590 

SETO 

600 

SETO 

610 

SETO 

620 

SETO 

630 

SET01640 


ll§| 

ETOl 


65 

66 


SET0167. 
SET0168Q 
SET01690 
SET01700 
SET01710 
SET0|720 
SETOITSO 
SETOI740 
SET01750 
SET01760 
SET01770 
SETOITSO 
SET01790 
SET01800 
SET01810 
SET01020 
SET01830 
SET01840 
SET01850 
SET01860 
SET01870 
SFT01B80 
SET01890 
SET01900 
SET01910 
SETO1920 
SET01930 
SET01940 
SET01950 
SET01960 
SET01970 
SET01980 
SET01990 
SET02000 
SET02010 
SET02020 
SET02030 
SET02040 
SET02050 
SFT02060 
SET02070 
SET02080 
SET02090 
SET02100 
SET021 10 
SET02120 
SET02130 
SFT02140 
SET02150 
SET02160 
SET02170 
SET02180 
SET02190 
5FT02200 
SFT02210 
5ET02220 
SET02230 
5FT02240 
SFT02250 
SET02260 
SFT02270 
SET02280 


FILE  SETU 


(M 

<M 


.EO.  COMMA) 60  TO  262 
.EU.  FRCO)  60  TO  264 
■ UHCO)  60  TO  2|| 


3TUN*ZCR0) 


264 


C 

i 


IF 

M a NUMMER(CAAOtCOLtOOOTl 
COL  a COL  - I 
60  TO  262 

v'  a FIN0T2(CAR0*C0L«E0UVEC) 

IF  (J  .EQ,  -1)  GO  TO  252 

M^a  number (CARO. COLtOOOTFIf ZERO) 

8obTFl^2''ooolFI  - 1 

60  TO  262 
OPTION  CARO 


330  M a NXTCHH (CARO. COL) 

(M  ,E0.  RLANK)GO  TO 

,E0.  ‘ “ 


IF 

If 


10§ 

340 

345 

m 


(M  .EO.  CBCO)  GO  TO 

(M  ,E0.  SRCO)  60  TO 

. (M  .EO.  ORCD)  GO  TO 

IF  (M  ,EQ.  MBCO;  GO  TO 

!F(M.EQ.ERCD)60  TO  355 
WRITE(6.33S) 

format (•  ERROR  ON  OPTION  CARO*) 
GO  TO  105 
340  CONO  a I 
GO  TO  360 
345  PRNSTS  a I 
GO  TO  360 
350  PRNDOT  a 1 
GO  TO  360 
355  EXITal 
GO  TO  360 
363  MIX  a 1 

360  J a FINO)2(CARn.COL.EQUCOM) 

■ ( J .EQ.  3)  GO  TO  330 
( J .EO.  -I)  GO  TO  105 


if 


C 

c 

c 


365 


3T0 

371 


EXCLUOE  CARO 

T0T0T3  a NUMR£P(CARO.COL.OOTVEC.TOTOT3) 
CALL  ORDER (OOTVEC.TOTOT3) 

GO  TO  105 

5TATFILE  CARO 

NXTCHRlCARDi 


IF 

(M  .EQ. 

IRC(j) 

GO 

TO 

3T4 

IF 

(M  .FO. 

ORCD) 

GO 

TO 

360 

IF 

(M  .EO. 

BLANK) GO 

TO 

105 

WR1TE(6.373) 

FORMAT (•  ERROR 
GO  TO  105 


ON  STATFl  CARO*) 


J i 
IF 


FIN012 
(J  .EO 


(CARD.COL. SLASH) 
n GO  TO  372 


STATKT  a 1 
M a NXTCHR(CARO.COL) 


372 

373 


374 

375 


IF  (J  .EO.  -1)  Gu  TO  372 
M a NUMHER(CAK‘).C0L*SAVTAP.ZER0) 
COl  a COL  - 1 
GO  TO  375 

376  J a FIN012.CAR0.C0L.E0UVEC) 

IF  (J  .EO.  -1)  GO  TO  37? 

M a NUM0ER(CARO. COL. STAFIL. ZERO) 
COL  a COL  ■ • 

STAFIL  a SI 
GO  TO  375 

3«0  J a FIN012( 


IF 

(H 

.FO. 

CCMMA)GO 

TO 

375 

IF 

(M 

.EQ. 

FrtCOI  GO 

TO 

376 

IF 

(M 

.NL. 

UHCD)  GO 

TO 

370 

J a 

FIN012(CARD.C0L.I 

EQUVEC) 

STAFIL  - 1 
MCARO. COL. SLASH) 


SET02290 
SET02300 
SET02310 
17023*9 

T02330 
..•T02340 
SET02350 
S?TOj 

iTOZl 
_ -toIaio 

SET0242e 

SET02430 

SET02440 

SET0245Q 

Ie?02476 

SET024B0 

SET02490 


SET02590 
SETU2600 
SET02610 
SETO2620 
5ET02630 
SET02640 
SET02650 
SET02660 
SET02670 
SET02680 
SET02690 
SET02700 
sET02710 
SET02720 
SET02730 
5ET02740 
SET02750 
SET0276Q 
SET02776 
SET027«g 


SET0279 

S|T02«00 

s|T02fll6 

SET02820 

SET02830 

SET02H40 

S^T02850 

SET02«60 

SET02R70 

SET02«e0 

SET02890 

SET02900 

SFT02910 

SET02920 

SFT02930 

5) T02940 

SET029S0 

SET02960 

SET02970 

5FT029HO 

SET02990 

SFT03000 

SFT0301Q . 

SET03020 

SET03030 

SET03040 


5bl 


I 


FILE  SETU 


i 


382 


IF  (J  .EO.  •])  6U  TO  372 
381  M « NXTCMM(CARO»COL» 

(M  .EQ.  COMMAjSO  TO 
<M  ,EQ.  FHCD)  GO  TO 
CM  *n|.  UHCO)  go  to  37$ 

J > FlNOl2(CAf<D<COI.*EQUyEC) 

IF  (J  .EQ.  -1)  GO  TO  372 
M • NUMREA(CARD*COL«OSAVTP*ZERO> 

S8S5  SSV  - ‘ 

J • FINDl2(CAROiCOL«EQUVEC) 

IF  JJ  ,EO,  -1)  60  TO  372 
M > NUMUER(CAR0*C0L«0STAFItZEr;0) 

COL  - COL  - 1 
OSTAFI  ■ OSTAFI  - 1 
GO  TO  381 

OOTLA8EL  CARO 

390  M « CR0SCN(CAR0»CATPTH.CATNrt2.CAT00T.N0CAT2,PTRl) 
MaNOOT  ■ I 
60  TO  lOS 

STATLA8EL  CARO 

400  H « CRDSCN(CAR0«PTR.CLSNH2*SUBRAY«N0CL2tPTR2) 
MANSTA  » 1 
GO  TO  105 

DISTANCE 

410  M m NXTCHR(C*R0.C0LJ 
M » NXTCHR(CAMO«COL 
IF  .EO.  HCOl)  ‘ 

IF  (M  .EO.  PCD2) 

GO  TO  I OS 

THPESHOLO  CARO 


oUt  ■ 1 

oiST  « 2 


420  M « FLTNUM(CAR0»C0L»T.1» 

GO  TO  105 

K nearest  DOTS 

430  J B NUMBER (CARDtCOLtNEARST.ZERO) 
GO  TO  105 


PROCEOUHE  CARO 

K-  nearest  procedure  ■ 

4LL-0F-A-KIND  ■ 

MANUAL  LABELING  OF  FILE 

440  M * NXTCHR(CARD.COU 


1 


IF 

(M 

.EO. 

KRCO) 

GO 

TO 

446 

IF 

(M 

.EO. 

ArtCO) 

60 

TO 

448 

IF 

(M 

.EO. 

MBCD) 

GO 

TO 

450 

WRITE (6.445) 

445  FORMAVC  ERROR  ON  PROCEDURE  CARO*) 
60  TO  105 

446  PROC  > 1 
60  TO  lUS 

44B  PROC  » 2 
60  TO  lOS 
450  PROC  ■ 3 
60  TO  105 

MODULE  CARO  DECK 

460  CALL  CRUSTA (ARRAY. TOP) 

5TATKY  « 1 
60  TO  105 


SUN  angle  CARO 


'/  r 


SET03050 
SCT03060 
T03070 
T030SO 
T03090 
T03100 
T03ll0 
T0312 
T03 


i»iij 


■T03I60 

\im\u 

SET03190 

5|I03209 

inm 

SET03230 
SET03240 
SET03250 
S|t03265 
SET03270 
SET032HO 
SET03290 
SET03300 
SET03310 
SET03320 
SET03330 
SET03340 
SET03350 
SET03360 
SET03370 
SET03380 
SET03390 
SET03400 
SET03410 
SET03420 
SFT03430 
SET03440 
SET03450 
SET03460 
SET03470 
SET03430 
SET03490 
SET03500 
SET035i0 
SET03520 
SET03530 
SET03540 
SET03550 
SET03560 
SET03570 
SET03580 
SET03590 
SET03600 
SET03610 
SET03620 
SET03630 
SET03640 
SET03650 
SET03660 
SET03670 
SET036bO 
SET  0 3690 
SET03700 
Sf  T0371  J 
SET03720 
SFT03710 
SET03740 
SF1 03750 
SF  TO (760 
SE  T03770 
SET037H0 
SET03790 
SETOjaOO 


JLS-57" 


FILE  SETU 


C 


i 


C 

C 


c 


8 


8 


♦ 70 

♦ 7^ 


490 

*9 

49 

494 

49« 

499 


500 


510 

520 

530 


540 


550 


560 


SUNAN6  X ^ *I^^LFS  AR| 


ANGLES  AR 
. . -(I^CCAROfCO 
<M  .NE.  FrtCO) 


M > NXTCHI$(CARO 


vr  V (_  erf 

=8b’ 


ON  DOTFIL 
DS 


ON  CARO! 


TO  475 


TO  496 
TO  105 


5UNAN6  a 1 
60  TO  105 

iOL  a COW  - 1 
F«M.NE.FHCOl  60  TO  475 
UNANG  a 2 
0 TO  105 

MAPTAP  CARO  —DISPLAY  INTERFACE  TAPE 

M > NXTCHR(CAR0*C0L) 

IF  (H  .Eo.  0BCi>)  no 

IF  <M  ,EO.  5LANK)G0 

WRITE  «(St494» 

FORMAT (•  ERROR  ON  MAPTAP  CARD') 

60  TO  105 

J a FlNOUtCAROfCOLfSLASH) 

IF  (J  ,E«.  -1)  GO  TO  492 
OSPKEY  a I 

M « NXTCMR(C»RD.C0L) 

IF  (M  .£Q,  COMMAIGO  , 

IF  (M  .EO.  FHCO)  60  TO  50( 

IF  (M  ,NE.  UHCD)  60  TO  49} 

J a FlN012(CAR0«C0L«E0UVECi 
IF  (J  .EO.  -1)  GO  TO  492 

NUMBER (CARO<COL*OSPUNTtZERO) 

_ a COL  - 1 
uO  TO  498 


COL 
60  1 

J > FIND12(CAR0«C0LiE0UVEC) 
IF  (J  ,fO.  -1)  60  TO  492 
M > NUMhER<CARn.COL»OSPFILt 
05PFIL  a nsPFIL  - 1 
COL  a COL  - 1 
GO  TO  498 
DATE  CARO 

M B NXTCHR(CARO.COL) 

IF  (M  ,E0.  RLANKlGO  TO  105 
PFAf)(30f52O)OATE 
REWIND  RRUNIT 
FORMAT(10Xtl5A4) 

60  TO  105 

COMMti^T  CARO 


ZERO) 


M s NXTCMR(CARDiCOL) 

IF  (M  .KO.  RLANKIGO  TO 
PE*D(30.520)COMENT 
REWIND  RRUNlT 
60  TO  105 


105 


MEDl 

M 3 NXTCHR(CARn.COL) 

IF  (M  .EO.  HLANA)GO  TO  105 
PEAD<30.520)HEOl 
REWIND  HRUNIT 
60  to  105 

HE02 

M r NXTCM«(CARD.COL) 

IF  (M  .EO.  HLANKIGO  TO  105 
PEAD(30.520)HED2 
REWIND  RRUNIT 
60  TO  105 

•END* 

CONTINUE 


II  sidj 

78illi 

SFT0393C 
SET03940 
SET 03950 

ifisim 

insiiii 

SET04000 

sEToaoio 


ro40 
SET04 
SET04  . 
S|r0404 
SET0405 
SFT0406 
SET0407 
SET0408 
SFT0409 
SET04 
SET04 
SET04, 
5ET0413 
setoaIa 
5ET04I5 
SET04160 

untih 

setoaUo 

no42o 


SET04230 

SET04240 

SET04250 

SET04280 

5CT04290 

SET04300 

SET04310 

SET 04320 

SET04330 

SET04340 

SET04350 

SET04360 

SET04370 

SET04380 

SFT04390 

SET04400 

SET04410 

5ET04420 

SET04430 

SFT04440 

SET04450 

SFT04460 

SET04470 

5FT04480 

5ET0449 

5FT0450 

SET04S1 _ 

Sf T04520 

SFT04530 

5."T04540 

5ET04550 

SET04560 


riLE  S£TU 


PRnCEOlWe  1 ANP  2 CANNOT  BE  SELECTED  ALONG  WITH  PROCEDURE  3 


070 


5«0 


S90 


if 


WRITE (6*206d» 

PROC. ■ 3 

(MANSTA  ,F0,  0) 
fPROC  .EO,  3)  GO 
WRITEI6«2060> 

RROC  > 3 


CONTINUE 
WRITE(6.|000) 


EO.  3>  GO  TO  570 

:(8:  i?8 

50) 


^TO.580 
0 5B0 


. 0)  GO  TO  570 


IMANOOT  .EQ.  0)  60 
(PHQC..EO,  3)  GO  Ti 


Vi,? 


90 


p 

^OOH  A;  ft 


QU4c^ 


ITy 


If 

IF 


(NOrET?  ,NF. 

(NOFEAT  ,n|. 

(MARKEV  .fq. 

(ManOOT  ,eo. 

(MANiTA  .EU, 

. (OSPKET  .EO,  . 

IF  (PROC  .FO.  1)WRITE(6. 1066) 

IF  (PWOC  .FO.  ?)wRITE(6,1070) 

IF  (OIST  ,FQ.  1(«R?TC (6. lOPO) 

IF  (OIST  .EQ.  ?)whITC(6.1090) 
WRITF(6.2000)T 
WRITE (O.2010)NFAhST 
F (SiJuANfi  .FO.I)WOITF(6.2020) 

F (SUNANG  .E0.2) WRITE (6.2030) 

F (SUNANG  .FO.O)wRiTE{6,20*0) 
F(l)i)T«FY  .FO.  1)  WRITE  (6.2070) 

F (STaTKY  .EO.  1)  WRITE (6.2080) 
F (COnO  .F(J.  1)  WRITE(6,2090) 

F (MIX  .Ej.  I)  .RITE(6.3000) 

F (PRNOOT.EO.l)  wRITF(6» J020) 

F (PRNSTS.EO.l)  wRlTE(6.3030) 

IF (EX  IT. EU.l) WRITE (6. 3060) 

RR  B 0 

(PROC  .EO.  3) 

(STATKY  .NF. 

(noTKEY  .n|. 

(CONI)  .FO.  i 
(PROC  .FO.  i) 

(MAPKfY  .NE. 

(IVRR  .EQ.  1) 

ONTINUE 


0)  WRITE (6. 1010) (FFTVC2(I) .I«l,NOF 
O:  WHiTF(6.i020) (FETVEC(I) .IbI.NOi 

1)  WRITE (6. 1030) 
p WRITE (6.1060) 

1)  WRITE (6.1050) 

1)  WRItC(6.!0S5) 


fH' 


T) 


60  TO  600 
})  . 

.OR.  . __ 

60  TO  595 
1)  lERR  ■ 1 
WRITE(6.3010) 


I lU  QUO 

IFRR  B 1 
lERR  B I 
).  MIX  .EO.  1) 


30  TO  596 


1000 

loin 

1020 

030 

060 

050 

loss 

1C60 

1070 

lOAO 

1090 

2000 

2010 

2020 

2030 

2060 

2050 

I 

2060 

. 

2070 

2050 

2090 


format ( 
format ( 

FORMAT ( 
FORMAT! 

format ( 
FORMAT! 
FORMAT ( 

format ( 
format ( 
format ( 
format ( 

FORMAT ( 

format ( 

FORMAT ( 

format ( 

FORMAT ( 

format { 
) 

format* 
OOTF  IL 
FORMAT  ( 
FOR  HAT ( 
FORMAT! 


FOLLOWING 
J.IX) ) 
•30(12.1 


OPTIONS  !•/) 


ixn 

IS  BEING  INPUT*) 


//•  USER  HAS  PEOUESTEO  THE 

• STAT  channels  are*. 30(12 

• OOTOATA  channels  ARE *.30 

• CLUSTEH/CLASSIF ICATION  TAPE 

• DOT!  11.  V.ILL  BE  PELARELEO*) 

• STAT  file  will  BE  RtLARELEO*) 

• martap  file  will  he  output*) 

• K-NfARLST  PPOCEOURE  WILL  HE  US 

• ALL-OF-A-wfNO  PROCEDURE  WILL  B 

• 11  OISTArjCf  will  he  used*) 

• L2  distance  will  be  USED*) 

I Threshold  DISTANCE  * *.F10.3) 

1*.  13. '-I^EARIST  DOTS  WILL  HE  USED*) 

• SUN  iM.i.FS  WILL  HE  EXTRACTEO  FROM  DOTFIL*) 

• SUN  AMjIES  will  BF  read  in  from  CAROS*) 

• NO  SUN  ANGLE  CORRECTION  Wl^^  BE!  APPLIED*) 


•0*) 

■ USED*) 


/•  NO.  U^  STAT  CHANNEL  AND 


106579 

T0660 
~966l 

)662 
T0663 
T0666 
T0665, 
T0666( 
T0667< 


7066  . 
T066S0 
T0669 


}0.T, 


DATA  CHANNELS  MUST  HE  EQUAL* 


/•  A LAPKl 1N6  PROCEDURE  MAY  NOT  BE  CHOSEN  WHEN  UPDATING  TMf 
OH  SAvTiH  f ILES* ) 

• noTEU  Fll.f  is  HFING  INPUT*) 

• SAVTAP  FILE  IS  BEING  INPUT*) 

• conditional  Cluster  map  will  be  output*) 


s 

I 

IfiStl 

SET0673 

SET0676^ 

SET06759 

5FT06760 

SET06776 

SFT06785 

SET 06 790 

SFT06B00 

itVotm 

SET06B30 
SETU6H60 
SEI06flSO 
SET06a60 
SET06B70 
SET06H80 
SET06890 
SET06900 
5ET06916 
SFT06920 
SET06930 
SET06965 
SET06950 
SET06960 
SET06970 
SET06980 
SET 06990 
SETOSOOO 
SET05010 
SET0502C 
SET05030 
SET05060 
SET05050 
SET05060 
SET0S070 
SET05080 
SET05090 
SETOSIOO 
SETOSilO 
SETosiao 

SET0S130 
SET05160 
SFT05150 
SET05160 
SET0S170 
St T 05 180 
SET0S190 

stTosaoo 

SETOS210 
SET0S220 
SFT0S230 
SET0S260 
CE  T0S250 
SE  T0S260 
SET0S270 
SFT0S2A0 
SETOS^-OO 
SE  TOSJOO 
SET  OS  *10 
SET0S320 


3yo 


me  scTu 


3000  eocrMOTC*  Mixro  CLUSTCO  MAP  W!l 


OUTPUT  * » 


30l0.r6«MATl/»  USCH  has  NOT  Rt&UiRCO  riLCS»*/T20» 


••SAVTAP 


I 


30?0  rO«MAT<«  PRINT  updated  OOTElWE') 

3030  FORMAT  I*  PRJNT  HtANS  ANO  COVAR|ANCES*l 
OaO  format**  exit  if  input  LABEL  NOT  USCO*) 

RETURN 

END 


SET0S330 

SF.T0S3A0 


f It 


^dJTY 


FTLP!  STOM*P 


C* 

C« 

C» 


CSEMD 


no 


1?0 


5URR0UT1NF.  ST0M4P(ILINt.NSAMP,HlST»LIMIT.BEGlNl) 

STOOAT  READS  AND  STORES  THE  CLASSIFICATION/CLUSTER  MAP  ON  DRUM 

im«»licit  integer  (A-Z> 

INCLUDE  COMokiS.UST 

COMMON/r'LOBAL/HEAD(63)  ,HAPTAPtDATAPE«SAVTAP.BMFlLE»BMKEY. 

HI-sFILtHlSKEY,TRFORM,ERIPTP.ERRKEY*MAPUNTtNOFlLF« 
nBllMAl),nRMki)«i.RA6SIZ»0ATFIL*STAF  IL*  ASAV*  ASAVFL 
.NMSTl)N.NHSTPI.SCTt<llN*'«APF  IL 

.DOTUMT.DOJFIL.NCHPAStTPMSFLtBMTRFLtHlSTFL.PCHUNT* 

crount.prtunt»ranoio 


dimension  hist  (LI  MIT)  fFETVECd  ) .FLO  (6)  .NLINE(A) 
TOTwBD  = ILINE*NSAMP 

IF  (TDT^'Hn  ,lE.  (nHMw0S-(DRUMA0-6E6INl)  ) ) GO  TO 

PRITE(ft»nO) 

format (•  NOT  ENOUGH  DRUM  SPACE  TO  STORE  DAS  TAPE 
CALL  CMERR 

CALL  TAPHOR (MAPUNT.MAPFIL) 

FETVFCm  = 1 


120 

data*  ) 


NOFEAT  s 1 
FLDd)  = 1 
FLD(2)  = ILINE 
FLD(3)  = 1 
FLD(A)  = 1 
FlD(S)  = NS AMP 
FLD(f.)  s 1 
PFGIN  = HFGINl 

CALL  FLOINKFLO  tFETvEC. NOFEAT) 

nUMPS  = TOThRD  / LIMIT 
TF  (MOR(T0T.°n, LIMIT)  .NE. 

TOTLN'S  = LIMIT  / NSAMP 
IF  (TOTLNS  ,GF.  ILINE) 

OMP  = DUMPS  - 1 

no  130  1=1. omp 

130  NLINF (T)  = TOTLNS 

NLINE  (DUMPS)  = ILINE  - TOTI.NS*OMP 
GO  TO  ISO 

140  NLINEd)  = ILINE 
ISO  no  200  J=l.ouMPs 

NU“LTN  = NLINE(J) 
no  lf>0  0=1*NIINILIN 
W0°ns  = NSamp* (K-1 ) 

ISO  CALL  LINER|)(HIST (-OR0S*!) .ENOTAP) 


0)  DUMPS  = DUMPS  ♦ 1 


GO  TO  140 


STORE  ON  HIGH  SPEED  DRUM 

NUOPns  = JORDS  ^ NS AMP 

CAl.L  RVHlTF(HEGIiv,,MlSTd)  .NWORDSt  1ST  AT) 
200  PFGIN  = HFHiN  ♦ NLINf(J)  * NSAMIJ 

MAPFR  = MAPFIL  ♦ 1 

PFTUPN 

ENO 


STOOOOlO 

ST000020 

ST000030 

ST000040 

STOOOOSO 

ST000060 

ST000070 

STOOOOSO 

ST000090 

STOOOlOO 

sTooono 

ST000120 
5T000130 
ST000140 
ST000150 
ST000160 
ST000170 
ST000180 
ST000190 
ST000200 
ST000210 
ST000220 
ST000230 
ST000240 
ST000250 
ST000260 
57000270 
STO002S0 
ST00029G 
ST000300 
ST000310 
ST000320 
ST000330 
ST000340 
STO003SO 
ST0003GO 
ST000370 
ST000380 
STO0C390 
ST000400 
ST000410 
ST000420 
ST000430 
ST000440 
ST000450 
ST000460 
ST000470 
STO0O4RO 
ST000490 
STOOOSOO 
STOOOS) 0 
STOOC520 
STO00S30 
ST000540 
STOOOSSO 
STO0GS60 
STOOOS70 
SI000580 


19.  UTILITY  SUBPROGRAMS 


FlLPt  BMFIL 


SURFOUTINF  RMFIL  (BMftTtLCOHB»NOFET*VEC»KEY) 
IMPLICIT  INTEGEH(A-Z) 

REAL  HMAT 


B. MATRIX  IS  READ  FROM  CAROS  AND  STORED  ON  FILE. 

STORAGE  MUST  8F  PROVIDED  IN  BMAT  ARGUMENT 
H-maTRIX  IS  HEAD  FROM  FILE. 

THE  VALDES  OF  LCOMg.NOFET  AND  VEC  ARE  READ  FROM  FTLF. 
this  function  can  be  used  FOR  ESTABLISHING  DIMENSIONS 
FDR  THE  P-MATRIX, 

THE  B-MATHIX  IS  PUNCHED  ON  CAROS. 

THE  B-MATRIX  IS  WRITTEN  ON  FILE. 

•««•*•••••••#•••••••••••*•••••••***<'***•***•*•*********' 

definition  INPUT  FOR  OUTPUT  FOR 

LINFAR  transformation  MATRIX  KEY»A,5  KEY=1.2 

DIMENSIONS  LCOMB*NOFET 

NO.  OF  LINEAR  COMBINATIONS  KEYsA.S  mEYs1,?,3 

NO.  OF  FEATURES  KEY=A.S  KEY=1.?»3 

vector  containing  features  KEY=4.S  KEY=1»?»3 

USFD  IN  obtaining  B-MATRIX. 
dimens ION-NOFFT 

DIMENSION  H'^ATO)  .VECm 
INCLUDE  COM^Kh.LIST 

COMMON/GLOBAl./HEAO(f>3)  .MART  AP,  DAT  APE  .SAVTAP.BMFILE»BMKEY.^ 

hisfil.hiskey.trform.eriptp.erpkey.mapunt.noftle. 

nRUMAD.nRMJ0S.PA6SI2*DATFlL.STAFIL«ASAV,ASAVFL 

.mhstun.nhstfi .sctrun.mapfil 

.OOTUNT.OOTFIL.UCHPaS»TPNSFL»BMTRFL»H1STFL»PCHUNT» 

CRDUNT.PRTUNT .RANDIO 


r* 

c* 

DEPENDING 

c 

FIVE  I/O 

c* 

c* 

KEY*1 

c* 

c* 

KEY  = 2 

c* 

KEY*3 

c* 

r* 

c* 

KFY=A 

r* 

KEY=5 

r* 

c*** 

c* 

arguments 

c* 

BMAT 

c* 

c* 

LCOMB 

c* 

NOFET 

c* 

VFC 

c* 

c* 

CSEND 

10 

?0 


30 


AO 


1 no 
?nn 
300 
AOO 

soo 


GO  TO  no»?0.20.30»AO>  .KEY 

»EAO(21  .mOlLCOMH.NOFET.  (VECm  »I»l*NOFET) 
TK=LC0MH*N0FFT 

READ(21.200) (BMAT(I) »I=1.IK) 

GO  TO  40 
PFWINn  GMFILE 

PE  AD (BMFILE)LCOMB.nOFET. ( VEC ( I ) ♦ 1*1 tNOFET) 

IF  (KFY.Eg.3)RETURN 
!K=LCOmb*NOFFT 

PEAO(BMFILE) (BMAT (I) .1*1. IK) 

RETURN 

vrTTF  (PCHUNT.300) 

write  (PCr-UNT.AOO)LCOMB.NOFET,  (VECd*  . I = 1.N0FET) 
TK=LC0MB*N0FET 

WRITE (PCWUNT, SOO) (BMAT ( I > » I =1 . IK) 

RETURN 

REWIND  hHFILE 

WRITE (umFILE)LCOMH.NOFET. ( VEC ( I ) » I *1 »N0FET) 
!K=LCOMH«MOEET 

WRITE (PMEILF) (RMAT(1) ,1=1, IK) 

return 

EPPMAT (SX,I?.5X,I2,3X,30I2) 

EOOMAT (5X.5E 1P.6) 

EOPMST ( 'P-MATRIX  CAROS') 

EOPMATCCOMh  ',I2.'EFAT  ',  12, 'VEC*  ,3012) 
rOPMAT ( 'SmTRX' .StlS.B) 

END 


RFFOOOlO 
BMF00020 
BMFC0030 
OMF00040 
BMFOOOSO 
BMF00060 
BMF00070 
BMFOOOBO 
PMF00090 
BMFOOlOO 
BMFOOilO 
8MF00120 
BMF00130 
BMF00140 
BME00150 
BMFOOifeO 
»HFF00170 
BMFOOIBO 
PMF00190 
BMF 00200 
BMF00210 
BMF00220 
BMF00230 
BMF00240 
HKF00250 
•BMF00260 
OMF00270 
BMF002e0 
6MF00290 
PMF00300 
HMF00310 
BMF00320 
BMF00330 
BMF00340 
RMF003S0 
HMF003B0 
BMF00370 
PMF003R0 
BMF00390 
BMF00400 
HMF00410 
RME00420 
BHF00430 
RMF00440 
BMF00450 
HKF00460 
PMF00470 
BMF004B0 
BHF00490 
HMF00500 
BHFOOSIO 
6MF00520 
BMF00S30 
HHF  OOSA  0 
6MFOOSSO 
BMr OOSGO 
BMF  00S70 
HMFOnSPO 
HMFOObRO 
bMFQOGOO 
HM.F  0061  0 
8MF00620 


J^l' 

373 


r»or»r»rsor*nr»r>r»or»on 


FILE:  PNT4A1 


«;UPPOUTINF  pni*ahifld»inchp.ibn) 

DAVin  LEE  SHITH  17  OCTOPEP  1P77, 

A SUPPOUTTNE  TO  CONVEhT  INTERNAL  BINARY  NUMBERS  FROM 
THE  1NTE6FR*4  FOPM  TO  A STRING  OF  EBCDIC  CHARACTERS. 

THE  parameters  ARE: 

IFLO  IS  the  first  WORD  OF  A FIELD  IN  AN  ARRAY  IN  WHICH 
TO  STORE  THE  OUTPUT  EBCDIC  CHARACTERS.  ONE  PER 
WORD*  IN  A1  FORM.  I.E..  UNE  CHARACTER  PER  WORD.  WITH 
BLANK  FILL  TO  THE  RIGHT. 

INCHR  IS  THE  number  OF  EBCDIC  CHARACTERS  m THE  NUMBER  OF 

wopos  X the  width  of  the  field  to  re  filled. 

INCHP  should  ALSO  RE  OF  FORM  INTE6ER44. 

IPN  IS  THE  INPUT  TO  THIS  ROUTINE.  AN  INTEGER  IN  INTERNAL 
BINARY  FORM.  POSITIVE  OP  NEGATIVE  (TWO‘S  COMPLEMENT) 

IN  THE  LEGAL  RANGE  -2**31  TO  (2»*3l-l). 

INTE6ER«4  IEIO(20).  INCHR.  IBN*  1016(10).  IRL.  IHMI 
OATA  IDI6  / IHO.  IHl,  1H2.  IH3.  1M4.  1H5.  1H6.  1H7.  IHB.  IH9  / 
Data  IHHI  / IH-  / 

DATA  IHft  / 1H8  / 

LAST  X INCHR 
LBN  X IBN  . 

NER  * 0 

. LBN  ) 10.30.30 

10  NEG  X 1 

LBN  X -LBN 
IF  ( LBN  ) 20.30.30 

20  IFLO(LAST)  X 1H8 


LPN  X 214  74B  364 
LAST  X last  - I 
30  IF  (LAST  .LE.  0 > 
IPT  X last 
no  SO  I X 1,  last 
INDEX  X M00(  LBN. 
IFLD(IPT)  X IDIG( 
LBN  X LBN  / 10 
IPT  X IPT  - 1 
50  CONTINUE 

IF  ( NEG  .NE.  0 ) 
60  RETURN 

END 


GO  TO  60 


10  ) 
INDEX 


♦ 1 ) 


IFLD(l)  X IhMI 


bnI OtO^O 
BNIO 
PNlO 


SSSI 

0040 


BNiooe  . 
HNI 00050 
BNI 00060 
BNI00070 
BNIOOOBO 
BNI 00090 
HNIOOlOO 
BNIOOIIO 
HNI00120 
RN100130 
BN100140 
BNI00150 
BNI00160 
BNI00170 
BNiooino 
BNI00190 
BNI 00200 
BNI00210 
HNI 00220 
BNI 00230 
HNI 00240 
BNI0Q2S0 
BNI 00260 
BNI 00270 
BNI002H0 
BNI00290 
BNI00300 
BNI00310 
BNI 00320 
BNI 00330 
BNI00340 
BNI00350 
BNI 00360 
BNI 00370 
BNI00380 
BN100390 
BNI00400 
BN100410 


r>r>r)  no  o o nooo 


file:  bufill 


SUBROUTINE  bufill MREC.lUNlT*MAX»EC./IBUF/tNRPDS»ENUTAP.lERR) 
IMPLICIT  INTEGER  (A-ZI 

BUFILL  PFAOS  THE  MSS  TAPE  ONE  RECORD  AT  A TIME.  A MAXIMUM  OF  10 
RECORDS  PFR  D4TA  SET  MAY  BE  PROCESSED  AT  A TIME 


DIMENSION  IBUF(765) 


lERR  * 0 . 
ENDTAP  * n 
K * 0 

DO  20  Isl.lO 


MAX  X MAXOEC  / 4 

READ<IilNlT.100,ERR=50.ENO»60)  ( IBUF (K* J) « Jx I ,mAX» 
100  format  ni <2bOA4) ) 

IREC  = IRFC  ♦ 1 

IF  (IPFC  .GF.  NRPDS)  return 

K X K ♦ MAXREC/4 


?0  CONTINUE 
RETURN 


SO  X(OITF<6,110)>*AXREC.J 
110  format(ix.I4.»  bytes 
lERP  * -1 
RETURN 


EXPECTED*/  IX. 14.  • BYTES  ON  RECORD*) 


ENCOUNTERED  AN  E-O-F 


60 


C 


ENDTAP  X -1 
RETURN 

END 


BUFOOOlO 

HUF00020 

BUF00030 

BUF00040 

BUF00050 

BUF00060 

BUF0007Q 

BUFOOOBO 

HUF00090 

BU^OOIOO 

BUFOOllO 

BUF00120 

BUF00130 

BUF00140 

HljFOOiSO 

BUF00I60 

BUF00170 

8UF00180 

BUF00190 

H'jFOOaOO 

HUFOOllO 

BUF00220 

PUF00230 

B1IF00240 

BUF00250 

BUF00260 

bUF00270 

8UF00280 

BUF00290 

BUF00300 

BUF00310 

riUF00320 

BUF00330 

BUF00340 

BUF00350 


f'ACiK  i 

looii  QUAIJTY 


on  oooooonnooooooonn 


FILF:  CHAIN 


SU«^R0UT1NE  CHAIN(CLO) 


« 


* 

* 


« 

« 


« 


THIS  SUBROUTINF  CHAINS  ALL  CLUSTERS  WHOSE  MEANS  ARE  LESS  THAN 
OLMIN  UNITS  APART. 

IF  - OISTANCE  between  CLUSTERS  L AND  M ♦ OLMIN 

OTSTANCE  BETWEEN  CLUSTERS  L AND  N s OLMIN 

distance  between  clusters  M and  N ♦ OLMIN 

THEN-CLUSTERS  L»M»  AND  N ARE  CHAINED 

INPUT  CLO-CLUSTEP  DISTANCES 

DLMIN-MINIMUM  DISTANCE  BETWEEN  CLUSTERS 

lncat-number  of  clusters 

OUTPUT  ICHAIN-ARL'AY  CONTAINING  NUMBERS  OF  CHAINED  CLUSTERS 
PRINTED  SUMMARY  OF  CLUSTERS  WHICH  WERE  CHAINED 


IMPLICIT  INTEGER  (A-X» 

INCLUDF  C0m=>KS.LIST 
INCLUDE  C(JM9Kh,LIST 

COMMON/P ASS/STOP. LNCAT.NMIN»KRNtSTOMAX.OLMIN»SEP» 

* MAP.SPTRIG.  IRD*  KPTS*  N0PTS»  PUNCH, 

* ICHN.CHNTHS, ICHAlN(62) ,NWDS» IPEGIN, BEGIN!, 

* BEG1n?,BEGIN3,CLSNAM,NOFLO,IPT,TOTWRO,TOTPTS, 

* NCLASS,NnCLS,TOTSUB,TOTFLO,TOTVRT,NOCL,NVRT 

* ,NXTCLS, NOFEAT. MAXCLS,FtTVFCnO)  ,SYMMTX(ft?) 

*.VAR5I7.STaTKY, lSnKEY,MAPFMT,MAPKEY,SEOUEN(20) ,PERCFN,SIMERP 
*. lORDER. INUNIT, INF  ILF, INI TM,PMIN,SUBVEC( 62) ,N0SUB2« CHNVC ( 30) 

* , NOCHAN.FRCOmP, NOSED. ME  ANDO, ME ANDU, 

* SYMOO.SYMI'U,  ITRIGO,  ITRIGU.DOFLAG, 

* DUFLAG,00riU,STDOT5(60)  ,NSOOTS,SUNCOR  (30)  ,LLNCAT, 

* OVERT(?S0,2) .ORECT (60,2) ,OVPNT ( 1 1 , 2) , IOCNT ( 2) ,NDOU(2) 

* .MXFFTl iMAXPOP 
REAL  SUNCOR 

C0hM0N/GL0BaL/HEAD(63) ,MAPTAP,0ATAPE,SAVTAP,BMFILE,BMKEY, 

* HISFIL .hi SKEY,TRFORM,ERIPTP,EPPMEY,MaPUNT, NOFILE, 

* OPUMAO,ORMvgDS.PAGSIZ,DATFIL,STAFIL,ASAV,ASAVFL 

* ,NHSTUN,NHSTFI .SCTRUN.MAPFIL 

* ,D0TUNT.0nTFTL.MCHPAS,TRNSFL,3MTRFL,HlSTFL,PCriUNT, 

* CPOUNT ,PBTUNT,RAN0I0 

C«iFND 

FOniVal.FNCE  (SYMHLS,SYMMTX) 

DIMENSION  JP(62) ,CLO(MAXCLS,MAXCLS) ,SYMBLS(62) 

PEAL  CHfiTHS.CLD 
IHO  = 0 

DO  10  I=1,LNCAT 
10  ICHAIN(I)  = I 
20  no  30  1=1 .LNCAT 
30  .JP(I)  = I CHAIN!  I) 

T=n 

40  1=1*1 

IF  (I. GE. LNCAT)  GO  TO  60 
M=l*l 

DO  50  J=M. LNCAT 

IF(CLO(I,J) .GT.CHMTHS)GO  TO  50 
ICHAIN(I)  = MINOdCHAiNd)  ,ICHAIN(J)  ) 

ICHAIN(J)  = ICHAlfg(I) 

50  CONTINUE 
GO  TO  40 

60  DO  70  1=1. LNCAT 

IFdCHAlN(I)  .NE.JPd)  )60  TO  20 
70  CONTINUE 
M = 1 

KNCAT=LNCAT 
«0  KrO 

JM=M  ♦ 1 

DO  OO  I = IM,|.NCAT 

IFdCHAIN(I)  ,NE.  M)  GO  TO  90 

KNCAT=KNCAT-1 
K = K*1 

SYMHLS(I)=SYMPLS(M) 

JP(K) r[ 

90  CONTlNtir 

IF  (K.F.).O)  GO  TO  lOO 
IF  (iHO.tu  0)  WRITE  (6,140) 

IF  (iHD.E'i.o)  WRITE  (6, HEAD) 

Ihn=l 

WRITE  (6,110)M,  (jPd),I  = l,K) 


CHAOOOlO 
•CHA00020 
•CHAOOOlO 
•CHAOOOAO 
•CHaOOOSO 
•CHA00060 
•CHA00070 
•CHAOOOeO 
•CHA00090 
•CHAOOlOO 
•CHAOOilO 
•CHA00120 
•CHAOOilO 
•CHAOOUO 
•CHAOOISO 
•CHA00160 
•CHA00170 
CHAOOIBO 
CHA00190 
CHA00200 
CHA00210 
COMOOOlO 
COM00020 
COMOOOlO 
COM00G40 
COH00050 
COM09060 
COM00070 
COM00080 
COM00090 
COMOOlOO 
COMOOllO 
COM00120 
COMOOllO 
COM00140 
COMOOOlO 
COM00020 
COM00030 
COM00040 
COM00050 
COM00060 
CHA00230 
CHA00240 
CHA002SO 
CHA00260 
CHA00270 
CHA00280 
CHA00290 
CHA00300 
CHA00310 
CHA00320 
CHA00330 
ChA00340 
CMA00350 
CMA00360 
CHA00370 
CHA00380 
CHA00390 
CHA00400 
CHA00410 
CHA00420 
CHA00430 
CHA00440 
CHA00450 
CHA00460 
CHA00470 
CHA004B0 
CHA004O0 
CHA00500 
CHA0051  0 
CHA00520 
CHA00530 
CHA00540 
CHA00550 
CHA00560 
CHA0OS70 
CHAOObPO 
CHA00590 
CHA00600 


J^4 

574 


file:  chain 


WRITE  (6.120)M 
100  MoM*i 

IF  (M.LT.LNCAT:  60  TO  80 
IF (KNCAT.FQ.LNCA!) RETURN 
WRITE  (<S«I30)KNCAT 
RETURN 

no  format  </•  THE  FOLLOWING  CLUSTERS  SHOULD  BE  CHAINED '.?0U» 

1?0  format:/*  in  THE  FINAL  OUTPUT  MAP  ALL  OF  THE  ABOVE  CLUSTERS  WILL 
*E  BEPRESENTFD  BY  THE  SYMBOL  FOR  CLUSTER* . 14//) 

130  format:*  the  AMOVE  CHAINING  REDUCES  THE  EFFECTIVE  NUMBER  OF 


*PS  TO  *,IS) 
140  FORMAT :iHl) 
END 


CHAOOSIO 
CHAG0620 
CHA00630 
CHA00640 
CHAO06S0 
CHA00660 
CHA00670 
BCHA00680 
CHA00690 
CLUSTECHA00700 
CHA00710 
CHAC0720 
CHA00730 


oonoo  ooo  r>  oin  ooon 


FILE  CHLOET 


15 

12 


i 

C 


SUBROUTINE  CHLOET ( KKK*NVtOUN*OET) 

THIS  ROUTINE  COMPUTES  THE  MODIFIED  CMOLESKY  DECOMPOSITION  OF 
THE  COVARIANCE  MATRIX.  THE  DECOMPOSITIONS  OVERLAY  THE  ELEMENTS 
OF  THE  COVARIANCE  MATRIX, 

KK  ■ L 0 L* 

KK  B COVARIANCE  MATRIX  STORED  IN  SYMMETRIC  STORAGE 

NV  B NO.  OF  CHANNELS 

OUM  B A WORK  AREA  OF  SISE  NV«1 

DET  B THE  determinant  OF  THE  COVARIANCE  MATRIX 


REAL  KK.KKK 
LOGICAL  JEl 
DIMENSION  KKKCl), 


OUM(l) *KK(465) 


COPY  COVARIANCE  MATRIX  FROM  KKK  TO  KK  TO  AVOID  OVERSTORING 
THE  INPUT  matrix 

ISIZE  B (NV»(NV«1))/2 
DO  5 I=ltISIZE 
KK(I)=KKK(I) 

CONTINUE 

DOUBLE  PRECISION  TF.  R,  Rl»  DUM,  T1 

JFl  B .TRUE. 

J1  a 0 
JO  B C 
DET  B 1.0 

LOOP  OVER  ALL  CHANNELS 

no  10  Jb1*NV 
KL  = J-1 
L B J»1 
JO  = J1 
J1  s Ji  ♦ j 
TF  = KKU1» 

IF(JEl)  GO  TO  12 
K1  = 0 

COMPUTE  THE  DIAGONAL  ELEMENTS  OF  0 AND  STORE  IN  KK 

TEMPORARILY  STORE  THE  PRODUCT  KK ( I » I ) *KK ( J, I ) IN  DUM(1I 

DO  15  IbI.KL 
R s KK(JO  ♦ iT 
K1  B K1  ♦ I 
R1  s KK(K1)  * R . 

TF  B TF  - R1  * R 
DUM(I)  s R1 

CONTINUE 

KK(Jl)  B TF 

CONTINUE 

PET  B DET  • TF 

IF  (L  .GT.  NV)  60  TO  10 

IRD  » Jl  - L ♦ 1 


COMPUTE  THE  Rt 
.NV 


16 


25 


no  20  IRs  L» 

IRD  = IRD  ♦ IR  - 
T1  = KKdRD  ♦ J) 

IF(JFl)  GO  TO  15 
DO  25  Is  1,KL 

T1  = TI  - OUM<  I)  * KKdRD  ♦ I) 
CONTINUE 

IF(TF.GT.0.D0)6O  TO  17 
OETbO 


J-TH  ELEMENT  OF  L ♦ USING  Tl 

1 


MCHOOOlO 

MCH00020 

MCH00030 

MCH0004Q 

MCH00050 

»«CH00060 

MCH00070 

MCHOOOGO 

t^HOOOGO 

MCHOOiOO 

MCHOOllO 

MCH00120 

MCH00130 

MCH00140 

MCH00150 

MCH00160 

MCH00170 

MCHOOiSQ 

MCH00190 

MCH00200 

MCH00210 

MCH00220 

MCH00230 

MCH00240 

MCH002S0 

MCH00260 

MCH00270 

MCH00280 

MCH00290 

MCH00300 

MCH00310 

MCH00320 

MCM00330 

MCH00340 

MCM00350 

MCH00360 

MCH00370 

MCH00380 

MCH00390 

MCH00400 

MCH004i0 

MCH00420 

MCH00430 

MCH00440 

MCH004S0 

MCH00460 

MCM00470 

MCH00480 

MCH00490 

MCH00500 

MCMOOSiO 

MCH00520 

MCH00530 

MCH00540 

MCH00550 

MCH00560 

MCH00570 

MCH00580 

MCM00590 

MCH00600 

MCH00610 

MCH00620 

MCH00630 

MCH00640 

MCH00650 

MCH00660 

MCH00670 

MCM00680 

MCH00690 

MCH00700 

MCH00710 

MCM00720 

MCH00730 

MCH00740 

MCH00750 

MCH00760 


FILE  CHLOET 


RFTURN 

KKdRO  ♦ J>  ■ Tl/TF 

CONTINUE 

JEl  > .FALSE. 

CONTINUE 

KK  CONTAINS  » IN  » »SYMETTRIC» • STORAGE.  THE  MODIFIED  CH0LE5KY 
FACTORIZATION  OF  THE  INPUT  MATPlX.  THE  LOWER  TRIANGULAR  MATRIX.  L. 
OCCUPIES  THE  OFF-OIAGONAL  ELEMENTS  OF  KK  « AND  THE  DIAGONAL 
matrix.  D « IS  STORED  IN  THE  DIAGONAL  ELEMENTS  IN  KK. 

RETURN 

END 


MCM00770 

MCH00780 

MCH00790 

MCH00800 

MCHOOSiO 

MCH00820 

MCH00830 

iMCHOOSAO 

MCH008SO 

MCH00860 

MCH00870 

MCH00880 

MCH00890 


13^1 

- 


OOOOl 


FlLEt  CLOIST 


THIS 

CLUSTI 


5U8ROUTINE  calculates  THE 
•R  MEANS 


WEIGHTED  DISTANCE  BETWEEN 


INPUT 


AMN (MEANS) 
STDEV 
LNCAT 
NOFEAT 


CLOOOOIO 
►••••••CLD00020 

•CLD00030 
•CL000040 
CL000050 
CL000060 

MEANS  OF  EACH  FEATURE  OF  EACH  CLUSTER  •SlOOOOAO 

standard  deviations  for  each  FEATURE/CLUSTERCL000090 


NUMBER  OF 
NUMBER  OF 


CLUSTERS 

FEATURES 


(CHANNELS) 


OUTPUT  CLD 


ARRAY  CONTAINING  DISTANCE  BETWEEN  CLUSTERS 
CLD(N»M)=OISTANCE  BETWEEN  CLUSTERS  N AND  M 


SUBROUTINE  CLDIST (CLO.STOEVt MEANS) 

IMPLICIT  INTEGER  (A-Z) 

INCLUDE  COMBkS.LIST 

COMMON/RASS/STOPtLNCAT.NMlN.KPN»STOMAK»DLMlN»SEP* 

• ^ map.sptrig,  iho.  kpts»  nopts*  punch, 

• ICHN,CHNTHS»ICHA1N(()?)  ,NWnS,IBEGIN,flEGlNl, 

* BEGIi'J2.BtGIN3»CLSNAM,NOFLD,  IPT  »TOTWRO»TOTPTS* 

♦ nclass.nocls»totsuh,totfld,totv»t»nocl»nvrt 

♦ ,NXTCLS»NnFEAT,MAyCLS,FETVFC(30) .SYmmtx (62) 
*,VARSI7.STATKY,iSOKEY,MAPEMT,MAPKEY,SEOUEN(20) ,PERCEN,SIME«P 
•flOROEP.  INUNIT,  INFILE,1NITM,PM1N,SUBVEC(62)  »N0SU82,CMNVC  (30 ) 

“ , NOCHAN, rPCOMP,NOSfcO.MKANDO,t'£ANOU» 

SYM00,SYMC)U,ITPIGa,ITRIGU.00FLA6, 

OUFl  AG , 000' ) , STOOT S ( 60 ) , NSOOTS . SUNCOR ( 30 ( , LLNCAT • 

OVERT (2S0.2) .ORECT (60,2) ,DVPNT(ll  ,2)  ,IDCNT(2) ,ND0U(2) 
,MXFFT1.MAXP0P 
REAL  SUNCOR 


CSENO 


STOEV, MEANS, CLO 

. means(nofeat,maxcls) 

DIMENSION  CI.O(MAXCLS,MAaCLS) ,STUEV (NOFEAT ,MAXCLS) 
00  30  1=1, LLNCAT 


REAL 
DTMENSION 


CLD(I',I) 

uy=iM 


■0. 


5 

10 


.and. 


STDEV(K« J) .GT.O.O)GO  TO  5 


15 


(I. FO. LLNCAT) 

DO  20  J=JJ, LLNCAT 
CLOd,  J)=n,0 
on  10  K=l, nofeat 
IF(STnEV(K,I).GT.0.0 
CL0iI,J>=999,99 
GO  TO  15 
CONTINUE 

CLO  ( I , J)  =CLO  ( I , J)  ♦ (MEANS  (K,  1 ) -MEANS  (K,  J)  ) **2/  (STOEV  (K  , I ) *STOEV 
*) ) 

CONTINUE 
CLO(I,J) 


•CLOUOJ 

•CLOOO 

•CLOOO 

•CLOOO 

•CLOOO] 

CLOOO] 


20 

30 


SORT(CLO(I,J)) 
CLD(J,I)  = CLD(I,J) 
CONTINUE 
CONTINUE 


return 

END 


00 

30 
40 

_ .50 

»CLOOOI60 
CLO00I70 
CL000180 
CL000190 
CL000200 
CLDOO2I0 
CL000220 
CL000230 
CLDC0240 
CL000250 
CL000260 
CL000270 
CL0002dO 
CL000290 
CL000300 
CL000310 
CL000320 
CL000330 
CL000340 
CLD00350 
CLD00360 
CL0C0370 
CL0003BO 
CL000390 
CLD00400 
CLD00410 
CL000420 
CL000430 
CLD004<.0 
CL000450 
CL000460 
CL000470 
CL0004P0 
CL000490 
(K,JCL000500 
CLOOOSio 
CL000520 
CLOC0530 
CLD00540 
CLD00550 
CL000560 
CLD00570 
CL0005B0 


F!LP»  CLSCMK 


W page  is 
^OOR  QUALITY 


SUBROUTINE  CLSCHK (CLSOES«SUBOES*FLOSAV« VERTEXtSUBNO* 

• NOFEAT*FETVEC*NOCLS«NOFLD*BMFL6«NOSUB1 


implicit  integer  (A-MfO-Z) 


THIS  SURROUTINE  IS-CALLED  FROM  REDSAV  TO  CHECK  THE  VALIDITY  OF 
USER  REQUESTS  REGARDING  SUBCLASSES*  GROUPING  AND  CHANNELS 


INCLUDE  COHrki.lIST 

COMMON/ INFOPM/NOCLS2.NOSUR2*NOFET2*VAOSZ2»TOTVT2*NOFLD?» 

► AVAR2*COVAM2,CLSI02»SURNO2.SUfl0S2*FL0SV2.VERTX2* 

^ FETVC2(30J  »SUHVC2(75) *SUBPTR(75) *CLSVC2(60) ♦ 

► KEPPTS(60) ,NOGRP,GRPNAH(60>  *GRPDEX(61) ♦ 

► GRPCHK(61) .6R0UPS(124) 


niMENSION  INVEPTOO) 
rlMFNSTON  SETI(<»0) 
data  maxFET/30/ 
dimension  FETVEC(30) 

DIMENSION  CLSOES(l) .SUBDES(l) »FLOSAV(«»NOFLD>  »VERTEX(l) 
niMENSION  SUHNO(l) 

JF(N0SUB2.LE.0)60  To"Zo 
Tl  = 0 

IPIG  8 0 - . . - 

DO  30  TS1.N0SUB2 
J = SUPVC2n) 

IFtJ.LF.IBIG  .OR.  J.GT.NOSUB)GO  TO  10 

II  = 11*1 

SURVC2nl>sJ 

IRIG  s J 

GO  TO  30 

wRTTE(f..20)  J 

) format (//5X.t**CLSCHK**  - requested  subclass  N0.*«I3»*  IS  NOT  AVA 
♦ILABLE  IN  INPUT  STATISTICS  — REQUEST  IGNORED*/) 

) CONTINUE 
NOSlJPPsII 

IF(NOSUR2.6T.0)6O  TO  60 
) NOSUB2=N0SUR 

IF(NOSUH,GT.60)NOSU82s60 
no  50  I*1,N0SUR2 
) SUPVC2(I!  » I 

CHECK  THE  GROUPS  FOR  VALIDITY 
) GRPTR  = 0 

IF  (NOGRP.LF.O)  go  to  110 
II  = n 

no  ion  i=i.N0GRP 

JR  = GoPDEXd)  ♦! 

JE  = JH*GW0IJPS(J8-1)-1 
GRPTR  s GWPTR*! 


T1  = r,BPTR 
00  on  JsJH.JE 
JJ  = GROUPS (J) 

IF( JJ.6T.N0SUR)G0  to  70 
GRPTR  = 6HPTR*1 
GROUPS (GRPTR)  = JJ 
GO  TO  90 

1 WHTTF  (*.,RO)JJ.I 

1 FORMAT (//SX. •••CLSCHK**  - requested  SUBCLASS  NO. ‘.IS  .•  FOR  GPOuP 
•MO.'.n.'  IS  NOT  AVAILABLE  IN  INPUT  STATISTICS  FILE'/) 

1 rONTINilK 
GRPTR  = GRPTR-1 
IF  (GPPTR.LT.il)  GO  TO  100 


CLS00120 
•ICL500130 
■ICLSOOUO 
CLS00150 
CLS00160 
CLS00170 
CLS00180 
COMOOOlO 
COM00020 
COM00030 
COM00040 
COM00050 
CLS00200 
CLS00210 
-CLS00220 
CLS00230 
CLS002AO 
CLS00250 
CLS00260 
CLS00270 
CLS002RO 
CLS00290 
CLS00300 
-CLS00310 
CLS00320 
CLS00330 
CLS00340 
CLS003S0 
CLSO0360 
CLS00370 
CLS003R0 
CLS00390 
CLS00400 
CLS00410 
CLS00420 
CLS00430 
CLS00440 
CLS00450 
CLS00460 
CLS00470 
CLS004B0 
CLS00490 
CLS00500 
CLS00510 
CLS00S20 
CLS00S30 
-CLS00540 
CLS00S50 
CLS00560 
CLS00S70 
CLS005R0 
CLS00590 
CLS00600 
CL500610 
CLS00620 
CLS00630 
CLS00640 
a S006S0 
CLS00660 
CLS006T0 
CLSO06M0 
CLS006NO 
CLS00700 
CLS0071 0 
CLS007/0 
CLS00730 
CLS00740 
CLS007S0 


r»rior»  nnoo  noon 


riLfJ  aSCHK 


[40 


170 


1«0 


fiRPTR  ■ ORPTR*! 

ORPTR-n 


??r?{! 

ARl 


»PDEX ( 
fiPPN4M(,.. 


|ll  : ii 


PNAM ( 1 ) 


DELETE  ALL  GROUP  SUBCLASSES 


110  |^*N0 


. <N- 

DO  140 
JR 
JE 
no 

KK 

no 


c* 

c* 


. **>60  TO  170 

IsitNOGRP 
GRP0EX(I)»1 
JR*6ROUPS(JB-l»-l 
130  J>JB»JE 


lEo  Kd.NOsyez 

IF(SURVC2(K).Ea.6R0UPS(J))60  TO  120 
KK  ■ KK*1 

SURVCP(KK)  ■ SUBVC2(K) 

PO  CONTINUE  ■ " 

30  NQSyPZ  « KK 
CONTINUE 

ADO  BACK  FIRST  CLASS  FROM  EACH  GROUP 


ISO  IC  ■ N0SUB2 

no  i<^n  i«i,moghp 

NOSUR2  « NOSUB2*! 
WAtsRPPOEXIT) 
n«GPOUPS(W4T^l) 
SUROFS ( I 1 ) *GPPNAM (1 ) 
160  SURVC2(N0SUR2)»II 


CONSTRUCT  GROUP  FOR  EACH  SUBCLASS  NOT  EXPLICITLY  GROUPED 


IF  (IC.LE.O)  GO 
DO  ISO  laltIC 
NOGRP  = N06RP*1 
GRPTR  s GPPTR*! 
GRPDFX (NOGRP)  « 
GROUPS (GRPTfl)  « 
TI  = SIIRVC2(I) 
GRPNAM (NOGRP)  « 
GRPTP  = GRPTR*1 
GROUPS (GRPTR)  « 
CONTINUE 


arrange  'SURVC?*  in  ORDER 


TO  190 


GRPTR 

1 

SUBDES(II) 

II 


lao 


IRl 


CALL  ORDER  (SIJHVC2.NOSUB2) 

USE  SURPTR  storage  TEMPORARILY  TO  SEE 
HAVE  BEEN  eliminated. 

1K»0 

no  191  I*l,NOCLS 

KsGDHNO ( I > 

SIIRNOC I ) «0 
no  191  L»1.K 
IK«lK*l 
SURPTR ( IK) si 
KNTsO 


IF  ANY  ENTIRE  CLASSES 


04  Is1.n0SU82 


193 

194 


TKsSI.iHVC2(I) 
ICsSl)aPTR(lK) 

IF  nC.FO.LOGO  TO  193 

9URN0(LC)»KNT 

LCsIC 

KNT  = ! 

GO  TO  194 
KNTsKNT*! 

CONTINUE 
SURNO(LC) *KNT 
DC  192  Isl.NOCLS 


:LS00760 

|miE 

>008? 


._]88I28 

CLS00900 

CLS00910 

CLS00920 

CLS00930 

CLS00940 

CLS00950 

CLS00960 

CLS0C970 

CLS00980 


[888 


CLSOIOIO 
CLS01020 
'CLS01030 
CLS01040 
CLSOIOSO 
^LSOIOGO 


CLS01210 


•CLSO, 

CLSOl 

CLSOl 

CLSO 

CLSO 

CLSO 

CLSO 

CLSO 


.0 
320 
330 
340 
3S0 
360 


CLS01370 

CLS013S0 

CLS01390 

CLS01400 

CLS01410 

CLS0i420 

CLS01430 

CLS01440 

CLS014S0 

CLS01460 

CLS01470 

CLS014H0 

CLS01490 

CLSOISOO 

CLSOISIO 

CL501520 

CLS01S30 

CLS01540 


19;rr^ 


• ♦ • 

CMJOOOCKJ  UOOU  UUUO 


FILCi  CLKCHK 


192  SET1(I)»-1 


1«»S 


C» 

c* 


c* 

c» 


200 

205 


210 

220 

235 


if 


?60 

270 


271 


- 1»1»N0CLS 

TFiSueNOtl) .rO.OlGO  TO  195 

iHnii.iK 

5UPN0]lK)>SU0M0(l) 

N0CLS2«IK 

iNlTlALIZe  SOflPTR  ARRAY  FOR  REOSAV  - 
tMAT  CONTAINS  THE  NEW  INDEX  FOR  EACH 
PROCESSING. 


SUBCLASS  TO  BE  USE 


CLS0)550 
■ ' 560 


SURP?S( 
no  205 
IK  « 5URVC 


I«l. 

:l)«o 

l*i* 


NOSUB 


N0SUB2 

m 

UBOESIIK) 

K)rT 

RE‘‘ET  grouped  SUBCLASSES  IN  SUBPTR 

IFINOGRP.EQ.OIGO  TO  235 
no  220  I*1.N06RP 
JP  B GPPnEX ( I ) *1 
JE  « J«  ♦ GOOUPS<JB-1)-1 
no  220  J«1.N05U82 

IF(SUBVC2(J)  .NE.GROUPSIJBDGO  TO  220 

no  210  kbjb.je 

IK«GROllPS(K) 

5U5PTR(IK)«J  . 
rONTINUe 
CONTINUE 
CONTINUE 


NOW  CHECK  ON  CHANNELS  REQUESTED 

IF(NOFET2.6T.O)GO  TO  23C 
no  225  lal.K'OFEAT 
225  FFTVC2(1)«FETVEC(I) 
N0FET2*N0FE«T 

230  CALL  0RDER(FETVC2»N0FET2) 

SET  UP  INVERT  table 


no  2*0  lal.MAXFET 
240  TNVEPT(I)  s 0 

no  250  IslfNOFEAT 
WAT«FETVEC<I) 

250  INVERT (WAT)  a I 

CHECK  V4LI0ITY  OF  REQUESTED  CHANNELS 


>0)  GO  TO  260 


670 

CLS016P0 


690 

700 

710 

720 

730 

740 

750 


II  » 0 
IRT6  a 0 

DO  2«0  I=1,N0FET2 
J rFFTVC2(I> 

IF  ( J.GT.maxFET.OR.J.LE. 

K e TNVEwT(J) 

IF  (K.LE.IHIG)  go  to  260 

II  = 11*1 

FETVCPdl)  a J 

IHIG  a K 

no  TO  250 

wRTTF  (*..270)  J . (FFTVEC(K),  Kai.NOFFAT) 
FOOMaT(//''  5X, ••••••  CLSFY/FETCHK  - — CHANNEL 

IINING  HATA TRAININCi  DATA  CHANNI  LS  A«E  ...» 

2 (5X,30I4/)  j 

IF(  HhFLG  .r,T,  0)  60  TO  272 

WRITF(4.27l)  J 


FOOHATI//  5«.»< 
1IC4T10N*/) 


channel  »tI3.‘  IGNORED  (NOT  USED)  IN  CLASSIF 


:lso 

^1:18 

CLSO 

^hl8 

CLSO 
CLS01760 
CLS01770 
CLSOITBO 
CLS01790 
CLSOIBOO 
CLSOIBIO 
CLS01B20 
CLS01830 
CLSC1840 
CLS0|850 
CLS01860 
CLS01870 
CLS01880 
CLS01890 
CLSO}900 

— — CLS01910 

CLS01920 

CLS01930 

CLS01940 

CLS01950 

CLS01960 

CLS01970 

CLSOJ980 

CLS01990 

CLS02000 

CLS02010 

CLS02020 

CLS02030 

— — CLS02040 

CLS02050 
CLS02060 
CLS02070 
CLS02080 
CLS02090 
CLS021C0 
CLS021 10 
CLS02120 

CLS02130 

CL502140 
CLS02150 
CLS02160 
CLS02170 
CLS0?1«0 
CLS02190 
CL502200 
CLS0221 0 
CLS0222O 
CLS02210 
CLS02240 
CL502250 
CLS02240 

•»I3.‘  NOT  IN  TSaCLS0??7O 

f,LS02?fl0 
CLS0??R0 
CL50230;' 
CLSn231 0 
CLSn?3''0 
CLS02330 


// 


35*5 


FK€l  CUSCHU 


60  TO  ?« 


272  WRItF(A. 
273  FOOMATt/ 


OF 


h 


27* 

2F0 

290 

300 


set  I 

l«RTTE(A,274l 
F09HAT <///// 


CFETVC2CK) •K«>*N0FET2) 
a*MATRlX  CHANN 
AVAILABLE  TRAININO  OaTA  CHANNi 


•//  (SX«30IA//)  ) 


ELS  HUS 
lELS 


HUST  BE 
THE 


AL  TO 
UT  B-l 


SUB-S 
X CHANK 


sx *••••••  TFRHINAT1N6  RROORAM  EXECUTION  FROM  FETCMX 


conVinuI 

NOFET2  ■ II 

SET  UP  REVISED  INVERT  TABLE 


no  290 


. _ «1,MAXFET 
INVERn  ) « Q 
no  300  ■1.N0FET2 


i: 


WAT«F 

INVE9 


.(1) 

(WAT)  ■ I 


The  class  no.  to  which  the 


c* 


c» 

€• 


30S 


SET  UP  CLSVC2  array  SO  THAT  IT  CONTAINS 
COPRESeONDING  SUBCLASS  BELONGS.  

Ho^’sOS  1«1.N0CLS2  • ■ 

lK«SUPNOn> 
no  305  Ksi.IK 

jBj.j 

CLSVC2<J)«I 

SAVE  FIELD  descriptions  FOR  CLASSES  AND  SUBCLASSES  TO  BE  USED. 

NOFL02-0 

IV«0 

JV>0 

DO  330  I»1.N0FL0 
JB»FLDSiv(3.n 

ARE  fields  ASSOCIATED  WITH  SUBCLASSES 
TFt Jfl,NE.Q)60  TO  306 


I r I win  • ’9r.  • u i 

IC«FLOSAvT2.|^ 


BEEN  eliminated 


30A 


307 


C* 

c* 


310 


3?0 

330 


HAS  This  CLa! 

NCaSETKIO 
TF(NC.Fq.-1)60  to  320  ■ 

NSIIRbO 
60  TO  307 
rONTINUE 

HAS  this  subclass  been  eliminated 

NSIIB  ■ SUBRTR(JB) 

IF(NsUO.FO.0)fi0  TO  320 

NC»CLSVC2(NSU8> 

fONTlHUF 

N0FL02«N0F|.n2*l 

FLnSAW<l,NOFLD2»«FL0SAV(l.I) 

FLnSAW<2,N0FLD2)«NC 

FLnSAVO.NOELD?)  »nSUB 

FLnSAV(A.N0FLO2)»FL0SAV(A»I) 

NOW  SAVE  VERTICES 
NV«FLDSAV(4.1>*2 
no  310  JbI.NV 
IV»1V*1 

VERTEX(IV)  ■ VERTEX<JV*J> 

JV«JV*NV 
GO  TO  330 

JV  » JV  ♦ EL0SAV(4.1)*2 

CONTINUE 

TOTvt?«IV/2 

RETURN 

END 


LS02ABt 
LS02A90 
LSOISQO 
LSof 

lIo|s3 

iim 

m\i\ 

LS0|S9( 
■■?600 
{610 


PL 

CLS02 

Mil. 

CLSO27S0 
CLS02760 
CLS02770 
CLS027B0 
CL$0|790 
CLS02800 
CLS02810 
CLS02820 
CLS02830 
CLS028A0 
CLSOliSO 
CLSO  * 
CLSC 
CLSO,.  . 
CLS02H90 
Cl|02900 
CLS02910 
CLS02920 
CLS02930 
CLS029AO 
CLS029S0 
CLS02960 
CLS02970 
CLS029M0 
CLS029R0 
CLS03000 
CLS03010 
CLS03020 


860 

870 

8A0 


r>orvr> 


FILft  CLSMIS 


IKFLXCIT  INTC6CB  «*-H.0-2» 
AeaL  XSCALEfXSHFT 


uoe  COMBK6.LIST 
N/6LOB*L/HEAnf63 


CtENO 
C 


nPUrt*0»f)R*<w 

--[r^ 

cp6unt*prtunIVpanoio 


/M£Anf63) «HAPTAP,OATAPE.SAyTAPiBMrH.EiBMKEYi 

Hr|PlL,HlSKEV.THrORHiERiPTP.£RP«Y»MAPUNTfNOriLCi 

Mw5S.PA0SXZfnxTriLfSTAFtLfASAV*ASAVFt 


•NMSTUNtNHSTri .icTRUNiMXPFlL 

.OOfUNT«gOfFlL»NCMP*S»TRNSFL*BMTRFL*HISTFLfPCHUNT. 


J MENTION  m1SVEC(3P» 
MFnSION  tally JNOMIST.XS 
pfCAL»l  0UMM(4)  ,SYMMU) 


Im 


XSI7>  *HISBUF(XSIZ) tXAXISIll) 
_ A) 

valence  (SYH.SYHM(l))  , (OUH.OUMMd)) 


ItlSSHS 

cl|oSoa8 

fLSOOOBO 

kfoOORO 

ksooioo 

K>-f22lt2 

xlnoiAO 


70 

BO 

00 


8 


ATA 

ATA 


star  /••!/.  BLANK/*  •/ 
OOLBCD/'$*/«  NUH1C/2F0/* 


ALPHAl/ZCO/ 


GO  > 1 
IN12 


10 

?0 

II 

?oo 

?oi 

30 

40 

«iO 


AO 

A? 

70 


JPTCNT  « { PA6SIZ-B)/(YS1Z  ♦ 10  ) 

nSlZ  ■ (XS17*B)/10  *1  - 

xscALE  « Float (xlow-xm6h)/(xsiz-i» 

XSHFT  « FLOAT (XSlZ*Xh6H-XL0Nl/(XSlZ-D 

no  20  uivDsiz 

XAXlS(l)  ■ (10*I-9)4XSCALE  ♦ XSHFT  • 0.501 

JCNT  » JPTCNT 

no  ifro  jfeat«i.nohist 

IF  (JCM.lt. JPTCNT)  GO  TO  40 

WRITE  (A, HEAD)  • 

IFfRO.FO.*.)  wRlTE(6.11» 

FOOMATC  DATA  TR«) 

IF(GO.FO.l)  WKITF(A,200)  TTL 
IF (GO.FO.O)  wRITE(A.20l)  TTL 

FOONAT  (T63.»hISTOGkAM»/T59.* '//TSS. 'TRAINING 

•LASS  A<./TS3. 

POOHAT  (T63,  • HISTOGRAM' /T59.  ' TR A INING 

*n  '.A4/TS3.'  •/) 

IF  (GO  .to.  2)  WHITE(6.14S)  TTL  * FLDPTS 

IF  (GO  .EO.  3)  WRITF(6.147)  TTL 

IF(GO.FG.O)  mRITF.  (*>.30)  FlOPTS*  TITLE 

FOOMaT (T4M, • (NO.  samples*  ».I7»'  . SUBCLASS*  '.A4,')'/) 

JCNT  a 0 

SCALE  AND  PRINT  THE  HISTOGRAM 


max  c 0 
YSCALF  » 1 
JCNT  r JCNT  *1 

no  so  jsi.xsiz 

IF  (TA(  LIT  ( JFE  AT,  j) 

CONTTNUP 

IF(MAX  .GT.  VSIZ)  YSCaLE  * 

K * HISVFC (JFFAT) 

IF (GO.FO.a)  gO  to  62 
WRITF(6.hA)  K 

FOPMATC  channel  '»I2/1X,' 

COM  IndF 
WPITP  {4,70)¥SCALF 

FOBMATCO'.TK.'FaCH  • REPRESENTS', IB.' 


.GT.  MAX)  MAX  * TALLY(JFEAT,J) 
(MAX. (VSlZ-1) )/YSIZ 


') 


POINT(S) .'/) 


no  120  jfsi.vsiz 

JH  * (VSIZ-(JY-) ) )*YSCALE 

Ik  a JH  - YSCALf. 

JfMP.XSIZ 


‘LS00220 

— ^mn 
— limm 

CLS00270 

CL5002B0 

CLS00290 

CL500300 

CLS00310 

CLS00320 
CLSU0330 
CLS00340 
CLS00350 
CLS00360 
CLS00370 
CLS0(i380 
Cl S00390 
CLS00400 
CL500410 
CLS00420 
CLS00430 
CLS00440 
CLS00450 
CLS00460 
CLS00470 
SUBCCLS004BO 
CLS00490 
FIELCL500500 
CLSOOSIO 
CLS00520 
CLS00530 
CLSOOSitO 
CLS005S0 

CLSOOSBO 

CLSOOSRO 

CLS00600 

CLS00610 

CLS00620 

CLS00630 

CLS00640 

CLS006S0 

CLS0O660 

CLSOO'sTO 

CLS006RO 

CLS00690 

CLS00700 

CLS00710 

r. S00720 

ClS00730 

CLS007<.r 

CLSn07S( 

CLS0076C 

CLS0077( 

CLS007fl( 

n snn70( 


non  r>  nnn 


file:  CLSHIS 


BLANK 

tHLYIjFEAT.I) 


60 

60 


TO 

TO 


90 

100 


60  TO  80 


no  100  IA7«1«JE»^ 

UIAZ 
Mi^BUEcn 

JK  _ 

SYM  » STAR 
IF  (JK.6E.JH) 

IF  (JK.LE.IKI 
JK  > JK-IK 
ZONE  * NUMIC 
IF  (JK.LT.IO)  60  TO  80 
ZONE  = ALPHA 1 
JK  » JK-9 
IF  (JK.LT. 10) 

SYM  r DOLBCD 
60  TO  90 
HUM  = ZONE  ♦ JK 
SYMK(1)=0UMM(4) 

HlSBl)F(I)  a SYM 
CONTINUE 

WRITE  (6«11P) JH. (HISBUF(I) vIxl.XSIZ) 
F0OMAT(lX.l6*»  I««1X«112A1) 

CONTINUE 

WRITE  (6*130) (XAXIStI) vIxlvDSIZ) 

format ( lOX* 1 0 • ) . • ♦ • »/9X. 1 1 ( I3*7X) ) 

WRITE  (6*140) 

format (»0*) 

FORMAT (T63. 'HISTOGRAM t/T59« 18 1 1H-) //T61* 'FIELD 

• / TS7,  22 (IH-),//  T56*  *(  NO.  SAMPLES  : '* 
147  format (T63* 'HISTOGRAM' »/T59» 18 (lH-)//T65tA4t 

* / T57*  ?2(1H*)) 
no  150  1=1*XSIZ 
TALLY(JFEAT*I)  a 0 
CONTINUE 

CALL  SETMR6(  66*1*65  ) 

RETURN 


80 

OO 

100 

no 

120 

130 

140 

145 


150 

160 


'*2X*A4 

17*  •)'  ) 


ENTRY  FLOHIS (TALLY*H1SBUF*TTL*XS1Z*XH6H*XL0W*YSIZ* 
►N0HIST*FLDPTS*T1TLE*MISVEC) 


GO  = 0 
GO  TO  10 


C 

c 

c 


FNTRY  HSTGHM( TALLY. HIsaUF*TTL*PRINT*XSIZ*XH6H.XLOW*YSIZ* 
•N0HIST,FLDPTS*HISVEC) 


60  = PRINT 
GO  TO  10 

ENTRY  COMhST(TALLY*HISBUF*TTL*NOH1ST*HISVEC*XSIZ*XHGH*XLOW.YS1Z) 
60  =4 

DO  12  I=1*N0H1ST 
00  61  J=l*50 
1TFM=TALLY(1,J) 

JT=102-J 

TALLY(I,J)aTALLV(I*JT) 

61  TALLY(I.JT)alTEM 
1?  CONTINUE 
GO  TO  10 
END 


CLS00800 

CLS00810 

CLS00820 

CLS0Sb30 

CLS00840 

CLS00850 

CLS00860 

CLS00870 

CLS00890 

CLS00890 

CLS00900 

CLS00910 

CLS00920 

CLS00930 

CLS00940 

CLS00950 

CLS00960 

CLS00970 

CL500980 

CLS00990 

CLSOIOOO 

CLSOIOIO 

CLS01020 

CLS01030 

CLS01040 

CLS01050 

CLS01060 

CLS01070 

CLS01080 

CLS01090 

CLSOllOO 

CLSOlllO 

CLS01120 

CLS01130 

CLS01140 

CLS01150 

'CLS01160 

CLS01170 

CLSOllBO 

CLS01190 

CLS01200 

CLS01210 

CLS01220 

CLS01230 

•CLS01240 

CLS01250 

CLS01260 

CLS01270 

CLS012R0 

CLS01290 

CLS01300 

CLS01310 

CLS01320 

CLS01330 

CLS01340 

CLS01350 

CLS01360 

CLS01370 

CLS01380 

CLS01390 

CLS01400 

CLS01410 

CLS01420 

CLS01430 


r 


FILE I CMEBR 


subroutine  cmerr 

NRITFIA.IOO) 

100  format t»  ERROR  HAS  OCCUR^COn 
„ CALL  EXIT 
RETURN 

END  1 


CMEOOOlO 

CMEOOOZO 

CHE00030 

CHEOOOAO 

CMEOOOSO 

CHE0006C 


r>or>  nnnnn  o on 


FILE!  CROSTA 


SEND 


iUj»ROUTlNE  CPOSTA(ARRAYfTOP) 

MPLlClT  fNTFGER  IA-Z)^X) 

NCLUOE  COMHkI.LIST 
NCL'inE  C0Mi>K6«LIST 

COMMON/IK  JOM/N0CLS2.N0SUR?.N0FET?*VARSZ?*T0TVT2.N0FLf)2.  . 

aVAP2.COVAH?.CLSIO2.SUBNO2»SUBDS2*FL0SV2»VERTX2» 
FETVC2(30) .SUBVC2<75) «SllBPTR(75) «CLSVC2(60) » 
KEPPTS(f)O)  ♦NOGMP»GRPNAM(60)  *fiRPOEX  (61  > » 
GRPCHK(M)  .6P0UPS(12*) 

COMMON/GLOBAL/HE AO (63) «MAPTAP.DAtAPE»5AVTAP«BMFILE»BMKEY» 

HISFIL.HlSKEYtTRFORM,ERIPTP.ERPKEY*MAPUNT*NOFILE« 
DRUMA0»nRVw0S«PA6SIZ»nATFlL*STAFlL»ASAV.ASAVFL 
♦ NHSTUN.KlwsTFIfSCTRlINtMAPFlL 

.OOTU'lT.OOTFlL.NCHPAS.TRNSFL.BMTRFL.MISTFLtPCMUNT* 

CRnURT»PHTUNT»wANDIO 

COMMON  /PASSB/  N0CLS»N0SU8»N0FEAT *NOFLOtTOTVRT* 

FETYECOO)  ♦FLDSVltCLSlDl.VARSIZ 
DIMENSION  ARRAY (1) 


READ  FROM  CARDS  KEY  WORDS  TO  BE  USED  IN  BASE  ADDRESSES 

REAO(CRDUNT»200)NOCLS.NOSUB»NOFEAT*NOFLDfTOTVRT 
200  F0PMAH6X.  lA,BX.I2»BA.I2»7XtI3»8X»i*) 

PEAD(CRDUnT«210) (FETVEC(l) ♦1=1»N0FEAT) 

210  FORMAT(10X,30I2) . 

COMPUTE  BASE  ADDRESSES 


VAOSIZ  = NOFEAT 
MAXFLD  = NOFLO 
rOVAPl  = 1 
AVARl  = cnVARl 


MAXCLS 

CLSmi 

SU^NOl 

SUPDSI 

Ftnsvi 

VPPTXI 

TIPTOP 

BADCOP 


N0SU3 

AVAPl 

CLSIDI 

SIJPNOI 

SUPOSl 

FLnsvi 

VERTXl 

TOP  - 


♦ (NOFEAT  ♦ 1)  / 2 

« VARSIZ 

♦ NOFEAT 

♦ NOCLS 

♦ NOCLS 

♦ NOSUB 

♦ N0FL0*4 

♦ TOTVRT 
TIPTOP 


IF  (BAOCO*^  .LT.  0)  (jo  TO  100 


CALL  RDMODK (ARRAY (AVARl ) t ARRAY (COVARl ) . ARRAY ( CLSiOl ) ‘ARRAY (SUBNOl 
* ‘ARRAY (SU0OS1 ) ‘ARRAY(FLOSVl) ‘ARRAY (VERTXl) *ARRAY(1) ) 


(50  TO  RO 

100  WRITE (PPTUNT‘ 190)  ^ 

IRO  F0PMAT(*  EXCFEOEO  CORE  LIMITS.  REDUCE 
♦FATURES'/  • EXITING  FROM  CRDSTA') 

CALL  CMERR 
90  CONTINUE 
RETURN 
END 


NO.  OF  training. CLASSES  OR 


CRDOOOlO 

CRD00020 

CPD00030 

CHDOOOAO 

CRD00050 

CRD00060 

CRD00070 

CRDOOOBO 

CR000090 

CRDOOIOO 

CRDOOliO 

CRD00120 

CRD00130 

CRDOOIAO 

CRD00150 

CRD00160 

CRD0017D 

CPDOOIBO 

CRD00190 

CR000200 

CRD00210 

CR000220 

CR000230 

CRD00240 

CRD002S0 

CRD00260 

CR000270 

CR000280 

CR000290 

CRD00300 

CR000310 

CR000320 

CRD00330 

CRD00340 

CRD00350 

CRD00360 

CH000370 

CPD00380 

CRD00390 

CRD00400 

CRD00410 

CR000420 

CR000430 

CH000440 

CPD00450 

)CRO00‘»60 

CR000470 

CRD004B0 

CR000490 

CRD00500 

FCKD00510 

CRD00520 

CRD00530 

CR000540 

CRD00550 

CH000560 


FILE:  OESCEN 


ORIGINAL  PAGE 
OF  POOR  QUALITY 


SUBROUTINE  OESCEN (SCN.LNCATtPTRl.PTRZ) 
IMPLlriT  INTEGEM(A-K) 

DIMENSION  PTHl (LNCAT)»PTR2(LNCAT) 

REAL  SCMLNCAT)  »SAVE 
J=0 

60 

IF(J.GT.LNCAT)60  TO  90 
IF(J.EQ.LNCAT)GO  TO  75 
IF(SCN(J).LT.SCNIJ»l))GO  TO  70 
GO  TO  60 
C 

70  SAVEsSCN(J) 

SCN(J)=SCN<J*U 

SCN(J*1)=SAVE 

c 

SAVE1=PTR1 (J) 

PTPl  (J)=PTR1  {J»D 
PTRl  (J*1)=SA\/E1 
C 

SAVE2=PTR2(J) 

PTR2(J)=PTR2(J^l) 

PTR2(J*1)=SAVE2 
75  K=J 

80  IF(K,FQ.1)G0  TO  60 

IF(SCN(K) .LT.SCN(K-l) )GO  TO  60  . . 

C 

SAWE=SCN<K-1) 

SrN(K-l )=SCN(K) 

SCN(K)=SAVE 

c 

SAVF1=PTR1 (K-1) 

PTRl (K-1)=PTR1 (K) 

PTRl (K)=SAVE1 

c 

SAVF2=PTR2(K-l) 

PTR?(K-i)=PTR2(K) 

PT«?(K) sSAVE? 

K=K-1 
GO  TO  80 
90  CONTINUE 
Return 
END 


OESOOOIO 

OES00020 

OE500030 

OESOOOAO 

OES00050 

DES00060 

OES00070 

DESOOOHO 

DES00090 

OESOOlOO 

OESOOllO 

OES00120 

OES00130 

OESOOIAO 

OES00150 

PES00I60 

OES00170 

OESOOlflO 

DES00190 

OES00200 

OES00210 

OES00220 

DES00230 

DES002A0 

DES00250 

OES00260 

DES00270 

OES00280 

UES00290 

OES00300 

OES00310 

DES00320 

OES00330 

OES003A0 

DES00350 

OES00360 

OES00370 

OES00380 

DE500390 

OESOOAOO 

DESOOAIO 

DES00420 


file:  OSTAPE 


C** 

C* 

C* 

C* 

c* 

c» 

c* 

c* 

c* 

c» 

c« 

c 

c 


ISOCLS  SU(^ROUTINE 

THIS  SUBROUTINE  6ENEPATES  A CLUSTER  IMAGE  TAPE  IN  EITHER 
universal  or  LARSYS  II  FORMAT.  THE  IMAGE  MAY  OPTIONALLY  BE  A 
ONE  channel  tape  reflecting  The  cluster  number  OF  EACH  PIXEL. 
OR  A 'NOFEAT*  CHANNEL  TAPE  REFLECTING  THE  MEAN  VECTOR  OF  THE 
CLUSTER  TO  WHICH  THE  PIXEL  WAS  ASSIGNED. 

SUBROUMNF  nSTAPEdPLACE.IBUF, MEANS. /FLOINF/) 

IMOLICIT  lNTFf.ER(A-X) 

INCLIIOP  C0MHK5.LIST 
INCLIIDF  COMDKA.LIST 

COMMON/pflSS/STOP.LNCAT.NMIN,KRN.STOMAX.OLMIN.SEP» 

• map.sptrig.  ird.  kpts.  nopts.  punch. 

• ICHN.CHNTHS, ICMAIN(A2» .NWDS. IBEG IN. BEGIN  1. 

• BEOIN?.eEGIN3.a.SNAM,NOFLD.lPT.TOTWRD.TOTPTS. 

♦ NCLo^S.NOCLS.TOTSUB.TOTFLD.TOTVRT.NOCL.NVRT 

* .NXTCLS.NO^FAT.MAXCLS.FFTVf C (30) .SYMMTX(6B) 

*,VAPS17.STaTkY. isokey, MaPFMT.MAPKEY,SEOUEN(20) .PERCEN.SIMERP 
*.IORriFH,lNUNIT.lNFILE,INITM,PMlN,SU0VEC (62) .N0SUB2.CHNVC (30) 

* .NOCHAN.ERCO.'P.NOSEO.MEANDO.mEANOU. 

• SYMOO.SYMOU.ITHIGO.lTRIGU.nOFLAG, 

* DUFLAG.DOniJ,STOOTS(60) ,NSnOTS,SUNCOR(30) .LLNCAT. 

* OVERT (?S0.?) .DRECT (60.2) »DVPNT(11.2) .I0CNT(2) *N00U(2) 

• .MXFET 1 .MAXPOP 
REAL  SUNCOR 

C0MM0;)/GL0bAL/HFA0(63) .MAPTAP.DATAPE.SAVTAP.BMFILE.BMKEy. 

HTSFIL.HISKEY.TRFORM.ERIPTP.ERPKEY.MAPUNT. NOFILE. 
DRi)MA0.nRM>-(n5,PA6SI2.OATFIL.STAFIL.  ASAV.ASAVFL 
.NmsTUN.NHsTFI.SCTPUN.MAPFIL 

.OOTUnT.OOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 

CROUN  T , PR TUNT , H and  1 0 

nivpNSlON  IRIlF(l)  .FETVC2130) 

real  mEanS(I) 

NC  = 1 

IF (MftpKEY.EO. 1 )NC=NOFEAT 
WRITE (6 .HE  AO) 

DIMENSION  fine (^) ,EL (22) 
nivENSION  IPTT(6?) 

FOUIVAt  FNCE  (FINE ( 1 ) .LINSTP) . (FINE(A) .SAMSTR) 

Eom valence  (FINE  (?) .LINENO)  ‘ ^ 

EOniVflENCE  (EINE(3) .LINING) 

DIMENSION  IPLACE (NOPTS) 

[>IMFNSTON  El  OINF  ( 1 ) 
niMPNSTON  FOPH(3.?) 

DATA  rOPM/MJNIV» , »ERSA* . 'L  '.»LAPS»»*YS  I».'I  •/ 

ir0UNT=0 
DO  3 I=1.LNCAT 
IPTT ( I) =I 

IF ( ICHN.GT.o)GO  TO  5 
DO  1 I=l.LNCAT 
1 ICMAIN(I)=I 
5 CONTINUE 

A0RFS=PE6IN? 

KrO 

IPFC=IRD 
IPTSrNDPTS 

10  IF(IREC.LE.l) IPTS=KPTS 
IF  (IRD.Efj.O)  GO  TO  20 
CALL  PRFAD( ADRFS. IPLACE.IPT8. ISTAT) 

IS  IFdSTAT.to.nGO  TO  15 

adofs=aohes.ipts 

20  CONTINUE 
IV=S 

DO  SO  IFLD=1,N0FL0 
HDPF.C  = 1 
NV  = Et.nTNF  (IV.n 
IP=lV.?*NV*2 
DO  2S  1=1.6 

?S  FINE  d ) =FI.OINE  (IH.I  ) 

LINESr  (LINFND-L INSTR) /LINING  ♦! 

I PTS  = (SAMFNO-SaHSTH) /SAMINC  ♦! 

NPTS=NC*LPTS 

IF  (NPTS.6T. 1 ISOO) GO  TO  HO 


CSEND 


C* 


(FINF(S) .SAMENO) 
(FINE (6) .SAMINC) 


»05T00010 
OST00020 
OST00030 
OST00040 
OSTOOOSO 
OST00060 
OST00070 
OSTOOOSO 
OST00090 
OSTOOlOO 
DSTOOllO 
DST00120 
OST00130 
OSTOOUO 
DST00150 
OST00160 
DST00170 
OSTOOIBO 
OST00190 
DST00200 
DST00210 
DST00220 
OST00230 
OST00240 
DST00250 
DST00260 
OST00270 
OST00280 
OST 00290 
DST00300 
0ST00310 
DST00320 
OST00330 
OST00340 
DST003SO 
0ST00360 
OST00370 
D5T00380 
DST00390 
DST00400 
DST00410 
DST00420 
DST00430 
OST00440 
DST00450 
DSTO0460 
DST00470 
DST00480 
DST00490 
DST00500 
OST00510 
OST00520 
UbI 005jO 
DST00S40 
DST00550 
DST00560 
DST00570 
DSTOOSflO 
DST00S90 
DST00600 
DST00610 
05T00620 
DST00630 
OST00640 
05T006SO 
OST00660 
DST00670 
DST006B0 
OST 00690 
DSTC0700 
D5T00710 
DST00720 
OST00730 
OST007A0 
DST007S0 
OST00760 
D5T00770 
DST00780 
OST00790 


mil']  IS 

QUALITY 


Flirt  OSTAPE 


C* 

C* 


LINE 

no  4 

ZERO 


LINSTR-LININC 


40  I>i«LlNES 
' IPUF 


DSTOOeOO 


?6 


70 


7P 


71 


27 

30 

31 


C 

C 

C 

35 


72 
74 

73 


C 

C 

C 


37 


40 


41 


SI 


00  26  J»1,NPTS 
intJF(J)aO 

LINE  » LINE  ♦ LINING 

CALL  FDLINT(FL0INF(IV»2) ♦NV.FLtLlNE»SAMPS»NFL) 
no  31  L*1.NFL.2 
IBa(FL(L)-SftMSTR)/SAHINC*l 
TEatFL(L*l)-S4MSTO)/SAMlNC  ♦ 1 

TF(MOn(SftMSTo.SAMINC) ,NE .MOO (FL (L) tSAMINC) ) IBaIB»l 
IFdH.GT.  It»GO  TO  31 
no  30  J=1B,IE 
K=K*1 

KPsIPLACE(K) 
irtMAPKEY.EO.DGO  TO  70 
IBME ( J) rlCHAlN(KP) 

GO  TO  75 
no  71  L7=1.NC 
JJ*(L7-1) *LPTS»J 
KK=(KP-1) *nOFEAT»LZ 
TPI'FIJJ)  = '■'EANS(KK)  ♦ 0.5 
!F(K.LT.IPTS)60  TO  30 
TPFC=IBEC-1 

IF  {IRFC.EO.O)  60  to  30 

iFdPFr.EO.n  iPTs=KPTs 

CALL  BRFA[)(40SES.IPLACEtIPTS»ISTAT) 

AOPES=AORFS*IPTS 
IFdSTAT.EU.DGO  TO  27 

KrO 

CONTINUE 

CONTINUE 

60  TO  (35*37) *HDREC 

WRITE  header  record 

CONTINUE 

LSTLIN  = 0 

LNFS  s 0 . 

TF(MAPKEY.E0.1)GO  TO  72 

FETVC2d)=l 

60  TO  73 

no  74  KK=1. NOFEAT 

FFTVC?(KK)=KK 

Hr>PEC=? 

NOFILF  = NOFILE  *1  , , ■ , 

CALL  WRTHE0(NC*FETVC2*LPTS*MAPFMT,MAPUNT) 

WRITE  DATA  RECORD 

LNES  =_LNE5  *1  . 

IF  (LNFb.tU.LINES.ANri.MirKEY. NE . l/LSTLIN*”! 

CALL  wRTLN( !HUF. LSTLIN) 

CONTINUE 

IF  (mapkEY.NE. 1 )60  TO  48  

IFdORt^ER.FO.  I )CALL  rank  ( nofeat *FETVC2 »LNCAT. MEANS tlPTI) 
no  41  I=1,NPTS 
IBHF (I) =0 

CAl  L WRTLNdBUF.LSTLlN) 

NTf^^Na  1 n 
JTFN=NTEN 
NCLUS=LNCAT 
0IV=1 1 
11  = 1 

NPL=LOTS/DIV 
TF(NH|..LE.O)  NPL  = 1 
IF  (LPTS.LT, 1 1 ) jTENsLPTS 
IF (LPTS.LT. n ) DIV=LPTS 
CNT=MRL 

IF  ( (NCLiiS-rjDL)  .LT.O)  CNT=NCLUS 

NCI  US=NCLUS-NHL 

I«;t=Nhl«  (I  I-’. ) »1 

IFN0=IST*CNT-1 

1 1 = 11*! 

ill=n 

no  4?  i=isT.iENn 
111=111*1 
no  42  K=1,NC 


OSTOOH30 
OST00646 
OST00650 
05T00860 
DST00670 
DST00680 
OST008RO 
OST00900 
0ST00910 
OST00920 
OST00930 
OST00940 
DST00950 
DST00960 
DST00970 
OST00980 
OST00990 
DSTOIOOO 
DSTOlOlO 
OSTQ|020 
DST01030 
OST01040 
OST01050 
OST01060 
OST01070 
DSTOIOOO 
OST01090 
OSTOlipO 
OSTOlllO 
DST01120 
DST01130 
OST01140 
DST01150 
OSTOl 160 
DST01170 
DSTOllflO 
OSTOl 190 
DST01200 
OST01210 
DST01220 
DST01230 
DST01240 
DST01250 
OST01260 
DST01270 
OST 01200 
DST01290 
OST01300 
OST01310 
OST01320 
nST01330 
OST 01 340 
OST01350 
DST01360 
DST01370 
DSTO130O 
nST01390 
OST01400 
DST01410 
OST01420 
OST01430 
nST0l440 
DST014S0 
DST01460 
DST01470 
DST01480 
OST01490 
DSTOISOO 
DST01510 
DST01S20 
DST01S30 
OST01S40 

nsToisso 

05101*580 

D5T01S70 

OST015R0 


riLEJ  OSTAPE 


KK«(IPTT(H-1)«NC*K 
no  42  J-NJTEN 
L»(ilI-l)*0fv*(K-l)*LPTS»J 
4?  T8IIF(C)  « MFANS(KK)  ♦ O.S 
DO  43  lal.NTFN 
!rOUNT»lCOUNT*l 

43  CALL  wPTLN<I8UF,LSTLIN» 
no  44  laltNPTS 

44  TflHF<I)aO 

TF(NCLilS.LE.f)»  LSTLIN—l 
CALL  WBTLNdBUF.LSTLIN) 

TF(NCLUS.GT.0»  60  TO  51 
4P  CONTINMF. 

WHITE  (»>,  60)  NOFILE.FLOlNFdV  - t (FOHM  <!  tMAPFMT ) . I«1 1 3)  »LNES 
•dCOUNT 

60  FOPM0T(///TS5t 'FILE  NO.  - • t I6f/T55. 'FIELD  NAME  - ••  A4»/ 
* T55,'F0«MAT  - ',3A4./T55«'N0.  OF  SCAN  LINES  - 'det/TSB* 


50 


AO 

Al 


••NO.  OF  COLOH  KEY  SCAN 
IV  a IV  ♦ NV«2  ♦ 9 
CONTINUE 
PFTUPN 


LINES  - 'flG) 


WHITE(5.81) 
F09MAT( 'THE 


NUMPFH  OF  channels  TIMES  THE  NUMBER  OF  SAMPLES  HAS 
' ■ ' OH  THE  number  of 


IF.xrFEnro  IISOO.DFCHEaSE  Thf  number  of  channels 
PSAMPLES.TEH'^INATInG  run  from  OSTAPE') 

CALL  CMEHR 


END 


05T01590 

OST01600 

DST01630 

DST01640 

OST01650 

osToibao 

OST01690 

OSTOITOO 

OSTOlTlO 

OSTO)720 

DST01730 

DST01740 

OST01750 

OST01760 

DSTOI770 

DST017BO 

OST01790 

DST01800 

QSTOl830 

OST01840 

OSTOIBSO 


ior>r>noi 


FILCt  FOLINT 


?1 

Cl 


C* 


100 


?00 

300 


400 

500 


510 


2000 


400 


700 


SU«ROUT I NE  FDL I NT ( F I EtO  t NPTS ♦ FL » YL 1 NE  *NS  , J J > 

THIS  SUHPOUTINF  wRU  RETURN  THE  PIXEL  NUHHFRS  OF  THOSE 
51>'fk5  ‘-iSl,TH4T  ARE  £onT*INE0  WITHIn  THE 
BOUNDARIES  OF  A N($N  -RECTANGULAR  FIELD 


INPUT 


FIELD  - 


NONE-RICTAN 
ALL.TH 
ORDi 


DUAL 


OUTPUT 


NPTS 

VLINE 

FL 

NSAMP 

JJ 


I^VER?VbES  MulV^BE  ife^CLOCKWlSe 

ER  AND  THE  LAST  VERTEX  HAS  TO  8E  E 

TO  The  first  vehtex  for  field  closure 
the  first  vertex  must  have  minimum 

poVn^s  of  the  n-r  field 
scan  line  number 

ARRAY  CONTAINING  THE  ORDERED  PIXEL  INTERCEPTS 
NO  OF  samples  CONTAINED  IN  THE  FIELD  OF 


A GIVEN  SCAN  line 
- THE  LENGTH  OF  THf 


ARRAY  FL 


DIMENSION  r ituiMjjtNt'iM  in 
INTEPER  XI »X2»Y1*Y2.XX»FL] 


INTFOER  XNM ♦YNH1,XNP2.YNP2 
1F(NPTS,E0.2)60  to  35 
ONE  VERTEX  FIELD 
L«  YLINE 
no  7 I 

FL(N) 

NPT  ■ 


FIELD»YLINE 


N 


1«8 

0 

NPTS-1 


»TSE 
I « 1 
JJ  « 0 

xi*field 

VI»F1ELD 
J ■ 1*1 
X2«FIELO(l»J) 
Y?«FIFLO(2* J) 
IF  ( 1 .EO.  1 


Mi.n 

1(2* 


I) 


) 60  TO  200 


60  TO  400 


TMl  e 1-1 
XNM1«p!ei.D(1  «IMJ ) 

YNMi»FIELD(2tlMi) 

60  TO  300 

XNM1»F1ELD(1,NPTSE) 

YNM1«FTELD(?.NPTSE) 

IP1  * I*l 
XNPl«FTFLrXl*lPl) 

VNP1xF1ELO(2.IP1) 

TF  ( I ,EQ.  NPTSE) 

IP?  « 1*2 
XNP2»F|FLn<] ,IP2) 

YNP2«FfELD(2.IP2) 

60  TO  500 
XNP2»F1EL0(1  .2) 

YNP2«FIELn(?,2) 

TF  ( Yl  .EU.  Y2  ) 60  TO  1000 
IF(  (L.FO.Y2) .AND. (YE.FO.YNPZ) ) 60  TO  2000 
IF(  (L.EO.Yl) ,AN0, (Yl.EQ.YNMl) ) 60  TO  2000 
PL  * L 
RXl  * XI 
RX2  « X2 
RYl  = Yl 
OY?  * Y? 

RXX  * ( ( (RL-RYl ) * (RX2-HX1 ) ) / (RY2-HY1 ) ) ^RXl 


60  TO  510 


XXsXX*l 


(XX 

(XX 


XX  3 RXX*. 5 
IF(Y1.LT.Y2( 

KXsPX  X 

IF(  (PXX-XX) .6T..5) 
continue 

IF  ((XX. GE.  XI)  .AND, 

TF  ((XX. LE.  XI)  .AND. 

I » 1*1 

IF  ( I .GT.  NPTSE  ) 60 
60  TO  100 

IF(L.LE.Y1.aN0.L.GF..Y2) 
TF(L.LF.Y?.aN0.L.6E.Y1) 

60  TO  ?oon 
JJ  = JJ*1 
FL(JJ)  3 XX 

IF  ( JJ  .EO.  1 ) 60  TO  2000 


.LE. 

.6£. 


X2) 

X2) 


60 

60 


TO 

TO 


600 

600 


TO  5 

GO 

GO 


TO 

TO 


700 

700 


FOLOOOlO 
FOL0002Q 
FDL00030 
FDL00040 
FDL 00050 
F0L00060 
FDL00070 
FDLOOOAO 
FOLOOORO 
FDLOOIOO 
FOLOoIlO 
FDL00120 
F0L00130 
FDL00140 
FOL00150 

FStSSin 

FOLOOinO 

FPLOOIRO 

FDL00200 

F0L00210 

FOL00220 

FUL00230 

FOL00240 

FQL00260 

FDL00260 

FOL00270 

F0L002A0 

F0L002R0 

FOL00300 

FDL00310 

FDL00320 

FOL00330 

FDL00340 

FOL00350 

FOL00360 

FDL00370 

FOL003H0 

FOL00390 

FDL00400 

FDL00410 

FDL00420 

FDL00430 

FDL00440 

FOL00450 

FOL00460 

FDL00470 

FDL00480 

FDL00490 

FUL00500 

FDL00510 

FDL00520 

F0L00530 

FOL00540 

FOL00550 

FDL00560 

FDL00570 

FOL005P0 

FOL00590 

FOL00600 

FOLO061O 

FDL00620 

FOL00630 

FDL00640 

FDL006S0 

FDL00660 

FDL00670 

FOLO06BO 

FOL606R0 

FOL00700 

FDL00710 

FDL00720 

FDL00730 

FDLOniAO 

FDL00750 

FDL00760 

FDL00770 

FDL007ft0 

FDL00790 


raei  folint 


TF  ( 1 ,NC.  NFW  I 60  TO  3000 
IFCL.NC.YZ)  60  to  3000 


3000 

3001 


4000 

1000 

7000 


XNMIbXI 

yn**!«yi 

X-  - 

V 

Y2«F!ELn(.. . 
fiO  TO  3001 
IF  1 L .NF.  Y1  I 60  TO 
IF  ((YI.LT.  YNMU  .4N 
IF  ((Yl  .GT.  YNMl)  .AMO 
GO  TO  ?000 
F|.(JJ|  ■ 0 
JJ  s JJ-1 
GO  TO  9000 

IF(L.NF.Yl)  60  TO  2000 
IF(X1.GT.X2)  GO  TO  SOOO 
IF(YNHl.LT.Yl)  GO  TO  60 
IF  ( YMF?  .GT.  Y2  ) 60 
JJ  > JJ«1 
FL<JJ)  ■ XI  • 

GO  TO  2000 
JJ  * JJ*1  ' 

FL(JJ)  ■ XI 
MM  « JJ*1 
FL(MM)  « X2 
JJ  B MM 
GO  TO  2000 


<Y1 


.6T 

.LT. 


. Y2  ))  60  TO  4000 
Y2)).  60  TO  4000 


7000 


6000 

TF 

( YMP2  ,LT. 

Y2 

) 

GO 

JJ 

B JJ*1 

fl 

(JJ)  B X2  . 

P(5 

TO  2000 

5000 

TF 

< YNMl  .LT. 

) 

GO 

IF 

( YNP2  ,6T. 

Y2 

) 

GO 

JJ 

« JJ*1 

TO  2000 


TO 

TO 


9000 

2000 


iFiNPtsE.ei. 


GO  TO  2000 
9000  IF  ( YNF2  .GT 
JJ  * JJ*1 
FL(JJ)  « XI 
MM  s JJ*1 
FL(MM)  b X2 
JJ  B HH 

GO  TO  2000 
JJ  ■ JJ*1 


2)FL(JJ)sXl 

GO  TO  0000 


Y2  ) 


BOOO 

5 

20 

29 

30 
39 


FL(JJ)  B XI 
60  TO  2000 
NPTSl  » JJ-1 
no  29  NI  B 1, NPTSl 
MPl  ■ MI*l 
no  29  NJ  B NPl.JJ 
IF  ( FL(MH  - FL(NJ) 


) 29.29t28 


NTFMP  s FL<MI) 

FL(MI)  s FL<MJ) 

FL(NJ)  B NTFMP 
COMTINUt 

MS  AMD  * 0 

no  30  N B 1.JJ.2 
MN  s N*1 

MSAMP  s NSAMP*<FL<NN)  -FL(N)*l» 

rOMTIMUE 

PFTUBN 

IF(YLINE  NE.FIELn<2»inPETURN 

FUDsFlELOd.l) 

FL(2»=FIfcLD(l.l» 

MSAMPsl 

JJs? 

PFTUMN 

ENO 


F^00660 

mww 

FDL00660 
FOC00690 
FOL00900 
FOLOO9I0 
FOL00920 
FOL00930 
FDL00940 
FOL 00950 
FOL00960 
FOL00970 
FDt00960 
FOL00990 
FOLOiOGO 
FDLOioIO 
FOL01020 

FpLOlOSO 

fBlo 

%8 

FOLollSO 

FOLOllAO 
FDLOlUo 
FDL01160 
FPLOllTO 
FOLOllftO 
FOL01190 
FDL01200 
FDL01210 
FOL01220 
FDL01230 
FOL01240 
FDL01250 
FDL01260 
FDL01270 
FOL01280 
FDL01290 
FOL01300 
FOL01310 
FOL 01 320 
Ff)L01330 
FDL01340 
FDL01350 
FDL013P0 
FDL01370 
FOL013GO 
FOL01390 
FULOUOO 
FDL01410 
FOL01420 
FDU01430 
FDL01**0 
FDL01450 
FDL01460 
FDL01470 
FUL01480 
FDL014P0 
FOL01600 


FTLFi  FINOl? 


FUNCTION  FIN012(CAR0fC0UtVeCT0R> 
IMPLICIT  INTE6FR  U-M.O-Z> 


FINOOOIO 


APRS.. 


FlND12(CAR0tC0Lt VECTOR) 

^ 2 p?p  TO^P^STTON  IN  *CARO» 

‘ !:sr* 

(N  IS  given  in  VECT0R<1) 

E6«  /2. •$•♦*«»/  ) 


REQUIRES*  NOR 

PURPOSE*.  USED  TO  LOCATE  SPECIAL  SYMBOLS  IN  »CARD» 


RETURNS. 


- PTS 

- PTS 


AT  SYMBOL  ( IF  LOCATED) 

AT  SYMBOL  LOCATED  IN  »VECTOR< 


dimension  CARDU).  VECTOR!  I) 

^ data  CRDSIZ/62/ 

K ■ VECT0R<1)*1 
L » COL* I 

DO  10  C0L*L.CRDSI2 
DO  10  UZ.K 
T1  * 1 

IF  (CAROiCOL) .EO.VECTOR(I) ) 60  TO  20 
10  CONTINUE 
I ■-! 

COL  « L-1  . 

?o  FiNni?  «I 

C WRITE!  (S.102)  !CAPD!K)  .f!«1.62).COL.I.VECTOR!I) 

C 10?  FORMAT!*  FINDIZ  ENTERED'/*  '.6ZAl.H0/*  '.15.A4) 
RETURN 
END 


•IF  N00060 
IF  N00070 
F NOOOBO 
IF  N00090 
IF  NOOlOO 
IF  NOOIIC 
IF  NOOIZO 
IFINOOfSo 

IFINOOIAO 
F NOOiSO 
F N00160 
F N00170 
F NOOIBO 
F N00190 

IF  NQ0200 
F NOOZlO 
F N00220 

f{nS8|aS 

F N00250 
F N00260 
F N00270 
F N002R0 
IF  N002Q0 
F N00300 
F N00310 
F N003Z0 
F N00330 
F N003A0 
F N003S0 
F N00360 
FIN00370 
F N003B0 
F N00390 
F N00400 
F1N004I0 
F N00420 
F N00430 
F N00440 
F N004S0 
F NOO460 
F N00470 
FIN004B0 


FILE  FLOINT 


SU-^bOUTInF  FLOlMTt/aLOCK/*/FeTVEC/*NOFEAT)  _ FLOOOOIO 

IMPLICIT  iNTF.fiFM  U-2)  FlOOOO 

EMTPY  FOR  P0<>IT10NInG  TAPE  TO  CORRECT  SCAN  LINE  FOR  A SPECIFIC  FIC^lB 

common  /TAPFPO/  lUNlT*lFMST«FSCANf$AM|NO*SAMlNCtREAOY«NSCAN«  FL 

• l,INC»10(POn»  .0SL»LMI)FI3B)  *JRCC(30>  f IAYTEOOI  »NRUFS*FILEN0«LINEN  FL 

*0  •LiNlNC*NSaMP«MOCHANtFONMT  FL 

DlMCNSiON  RLOCM#*)  , . , FL 

OlMCNSfON  FFTyFCCNOFEATi  FL 

Equivalence  i o(i>.N5pos  »t(io(2»»NCPR  >•  fl 

• « 0(3>.NBWC  ) « (fU(A) *ANCLMC) * fl 

• ( I)(S),NC  )«(iO(6)tNS  )t  fl 

• t r)(7).Nmrs  ).(tu(A)«oon*  fl 


iNO«LINEN  FL 

ft 


BEAOr  • 1 
N0CM4N  ■ NOFEAT 
CHFCK  FFTWEC 
12S  f»l*NOFE 


NO  00  TO  126 

CONflNUE 


CALL  CmERR 
127  continue 

lInsth»hlock<ii 
IF  (LINSTB.GF.IFP 
i«(rflTF(6.B30)  IFflST 
CALL  CMERR 
130  CONTlNUf 

IF(hLOCK(P)  .r.E.IF 


FPST)  GO  TO  130 


IF(hloCk(P)  .r.E.iFBsTIGO  TO  132 
wRITF(6.430> IFBST 
call  CmERP 
continue 

IF (FOWmT.FQ.3)GO  to  200 
lF(rn»JMT.F0.4)Gu  TO  |?0 


► FLInFbUosT  scan  om  oFCORO  CONTAINING  LINSTR 
FlINF  »L1nSTw-mOIH  (LlNSfH-IFwST) tNOSPRI 
LS« 1 ( FL I NF -F  SC  an ( /NUSPW- 1 ) •NMPOS 
fF  <LSKIP»  nS.13H,138  * 

13S  FSKIP  « (<8Li'C«U)  - IFNST)  / NOSPR  ) • NRPDS  ♦ 1 


OlMENSlON  FETyECINOFEATi  FL 

equivalence  i Olil.NBPOS  » t (I0(2» »NCPR  )•  FL 

• I 0(3».NBWC  >.(  U(4) *ANCLNC) * fl 

• ( N(G),nC  >«(  0(6)tNS  )t  fl 

• I D|7),N81TS  ).<,  0(|)«0QIjl.  fl 

• (in(9).NO|pM)*(10<iOl«NCAR  It  fl 

• (irf(ii»tSvi)).(iO(i6»tPRSZ)  fl 

BEAOr  • 1 FL 

NOCMAN  ■ NOFEAT  FL 

CHECK  FFTyEC  _ FL 

i^lTVEill?  fol.  NO  00  TO  126  fI 

12S  CONflNUE  fl 

GO  TO  127  FL 

12A  WRITEifttATOINC  FL 

CALL  CmERR  fl 

127  continue  fl 

Vf  aiNsVS^G^liFPST)  GO  TO  130  FL 

|«(P1TF(6. 430)  IFflST  FL 

CALL  CMERR  FL 

130  continue  . fl 

1F(hL0Ck(?) .GE.IEBSTIGO  to  132  Fl 

write (6.430) IFflST  fl 

call  CmERP  fl 

132  continue  fl 

if (FOWmT.FQ.3)GO  to  200  FL 

lF(FnwMT.F0.4)Gu  TO  220  Fl 

FLInFbUpST  scan  om  ofCOflO  CONTAINING  LINSTR  FL000300 

FLlNf  »L1nSTw-m0IH  (LiNSfH-IFtST) .NOSPR)  FL000390 

(FLINF-KSC4N(/Nl)SPR-1)a.NMP0S  FL 

fF  (LSKIP)  nS.13R.138  * FL 

135  FSKIP  « (<8Li'C«(l)  - IFRST)  / NOSPR  ) • NRPDS  ♦ 1 FL0004 

FL()00430 

ON  mult I-F ILF  Tapes  for  files  other  than  file  1.  DO  THE  FOLLOwING-FLO00440 

1.  HACK  SPACE  1 FILE  FL^ 

>,  RFAO  FOhWAmO  1 E-O-F  FL 

3.  REAP  FOwwAflO  NO.  OF  OESIREO  RECORDS  FL 

FLOOOAGO 

IF  (FILENO  ,F0.  0 .ANO.  FSKlP  .LE»  lABS(LSKlP))  GO  TO  136  FL000490 

FSkIP  « IA4S(LSK|P)  fl 

00  134  11^1, FSKlP  fl 

134  PACKSPACt  lUNlT  fl 

GO  TO  139  fl 

FLD00540 

FOR  file  1 00  A flERlNO  AND  SKIP  FORWARD  THE  OESIREO  NO.  OF  RECOROSFLUOOSSO 

136  REWIND  lUNlT  FL 

00  137  Ilsl.FSKIP  FLOOObBO 

137  B£AO(lUNlft480)OUMMY  FLO00590 

GU  TO  139  FL000600 

FL 

SKIP  DOWN  THE  TAPE  TO  BEGINNING  LINE  OF  THIS  FIELD.  FL 

FLD00630 

13fl  IF  (FSCAN.EO.FLINE)  go  TO  140  FLD00640 

IF  ( LSKIP  .FOrf  0)  GO  TO  139  Fl  1)00650 

no  141  li*l.LSKlP  FLD00660 

141  RFAI)(}unIT.4B0)  OUMMY  FLD00670 

139  continue  ‘ ' FL000680 

FSCAN»FLINE  FL000690 

140  CONTINUE  FLD00700 

NSCANsLINSTB  floootIo 

IF(HL0Ck{5) ,LE.NS)G0  to  145  FLD00720 

WRlTF(b.440)NS  FLD00730 

CALL  CMEkP  FL000740 

145  IFTHLOCK (4) .LF.NS)G0  to  146  FLU0n750 

WRITE (6.4401NS  FLU00760 


134  BACKSPACE  lUNlT 
GO  TO  139 


136  REWIND  lUNlT 

00  137  Ilsl.FSKIP 

137  B£AD(lUNlft480)0UMMY 
GU  TO  139 


no  141  lisi.LSKiP 

141  RFAI)(1unIT.4B0)  OUMMY 

139  continue 
FSCANsFLINE 

140  CONTINUE 
NSCANsLINSTB 
IF(HL0Ck{5) ,LE.NS)G0  1 
WRlTF(b.440)NS 


riLE  FLOINT 


r 

c 

r 

?A0 

r 

c 

r 

?20 


?30 

r 

14ft 


C* 


r* 

C* 

r« 


IftS 


CALL  CmCRR 

SKIP  rORMARO  NECESSARY  RECORDS  FOR  LANOSAT  1 OR  2 


DO  210 
REAQil 


I?** 


I«1.LINSTR 

UNlTf4dO)OUHHY 


nclUNlI 

ihu 


SKIP  RECORDS  FOR  LANOSftT  IH 

KlP*NRPns«a!NSTR-l» 

F (SkIP.FO.O)GO  to  146 
00  230  I-I.SKIP 
RF40(  ltlNltt4«0)0UMNY 
CONTINUE 


INUE 

neno«§loc 


COnT 

LINE 

LiNl 


LlNlNC«<^LO( 
^*yST«»yLO( 


:k(2) 

_ 15k<4> 
SAMFN0»iiLOCKl5) 
S«“INC«HLQCK(ft» 
^|nC»NO,oF  HECO^OS 


• ' IS 
vI('.\U!Y 


|nC« (LININC/NOSPR 
(LlNC.LT.n>LlNC«( 


TO  SKIP  after 
- ll*NRPUS 


EACH  SCCAN  LINE 


FSTA^jtlSH  AREAS  ON  EACH  SCAN  LINE  TO  UNPACK 


iF(FORMT.E0.3)r,o  TO 

If (forht,eo.4)Go  to 


ANCaASCLNO 
IF  ( FOBmT  .fO, 


1000 

^158 


anc^* 


samstb 

1 ) ANC 

MHUFSst<,Ot>nS2l0 
IF  < HOO  ( N»t»DS . 1 0 ) .NE , 0 ) NbUFS*NBUFS*  1 
FC*  1 
lC*ncar 
K«1 

no  iRo  i>i«nofeat 

TWV  ■ 0 

CONTINUE 

no  170  IwECXtNHPOS 
IF(-  - - 


iFdRfC.GT.n  ANC*2  ♦ SAMSTR  * SVD  - 1 
IF  <FETVEC(|j .GE.FC.ANO.FtTVEC(l) .LE.LC) 


ISO 


IftO 

170 
1 nil 

jRO 

r* 

r* 

r» 

ooo 

r 

C 

r 

1000 


C*2  ♦ 

E. FC. AND. FtTVEC(l) .LE.LC)  GO  TO  150 

IF  (FETVEC(l)  .C-T. LC.ANU.1HEL.lt. NHPOS)  GO  TO  160 
FC  « 1 
LC  ■ NCAR 
K « 1 

ANC  * (ANCLNG  * 2)  * SAMSTR  ♦ SVD  - I 
TRY  « TRY  ♦ 1 
IF  (TRY  .LE.  2»  GO  TO  185 
WRITE  (R.3«0)FeTVEC(I) 
call  C»-fRN 

iHYTE(n«(Fnvrc(i)-FC)«NS  * anc 


Fo.o)  jPEcm»io 


jRtc ( n «Mon(iRFc.io) 

IF  ( JWtC(  I 1 .FO.O  ■ 

LR"F < 1 ) al«tc/l 0 . I 
IF («no ( IREC. 1 O) .EO.O) LBUF ( 1 > «LBUF ( 1 ) -1 
GO  TO  JHO 

FC»LC*I 

LCaLC*NCPR 

Continue 

K*IREC 

continue 

>^Samp  - NO.  OF  samples  to  UNPACK  FOR  EACH  FEATURE  IN  FETVEC 

NSAMP  > (SAmENU  - SAMSTR)  / SAMlNC  ♦ I ' 

RETURN 

SET  UP  IRYTE  FOR  LANDSAT  1 OR  2 

JREC(1)*SAMSTP 
NSC AN*L INSTO 
FSCAN=L INSTR 
OU  notl  lal.NdFEAT 


flooottc 

ItB  1 

mm 

FLpoS: 

FLOOOA4( 

FlDOOSSO 

FLD008G0 

FLD00870 

FLOOOASO 

FL000890 

^FbBpi?e 

FLU00920 
FLD00930 
FLD0094C 
FLD00955 


,.88m 

FLD009S0 

FLO00990 


F^hB. 

FLOO 
FLOO 

FLOO 
FLOO 
ELOO 
FlOO 
FLOO 

ItRS 

fldo 

FLOO 

ItSl, 

FLOOl 

flooi 

FLOf. 

FLOO 
FLDO 
FLUO, 

flooi 

FLOO* 
FLOO 
FLOO 
FLOO 
FLOO 
FLOO 
FLOO 
FLUO 
FLOO 
FLOO 
FLOO 
FLOC 
FlOO 
FLOO 
FLOO 
FLOO 
Fl.')0 

fldo 
FLO01420 
Ft  1)01430 
f LU01440 
FLII01450 
FL001460 
FLOOi470 
FlO01480 
FL001490 

fluoisoo 
f Liiuisio 
FLO01S20 


rac  FLOINT 

l■|4|FFTvec^l) 


1100 


iHYTEClIi 

irMi 


•U*2 


. AND  NSCAN  FOR  LANOSAT  III 
TVEC  FO»  LANDSAT  III 


Roon 

?100 


00  ?100  I*l«NpFFAT 
rT6(n»F£Tv£Cn» 
..  'T 1 NUE 

nscan«lThsir 
FSCAN«lTnSTP 


fVf  r. 

|[BrT 


p 


Lh'»F  ( lV«^A^TR 
.0  TO 


> vnfl 

3«tl  rOMM4T(*  Ff 


ft88 

ftR8 

floo 


;ATUI<'C  NUHRERS**  ISt*  AND  ABOVE  ARE  NOT  ON  DATA  TAPE*/ 

<.30*I‘0‘*m*T(*  first  scan  ON  THIS  TAPE  IS  NUMBERED*  • I6»  • FIELD  OEF INI T IOFlOO  , 
•N  IN  FM<^OR*l  FLOO) 

fcAO  format (*  NOMHEP  of  samples  of  per  scan  ON  THIS  TAPE  IS*.I6t*  FIElOFLOO 
• OFF  1 nit  ION  IN  EPMOR*)  flop 

<.70  FO.<MATI*  THIS  tape  contains  ONLY*.  16.  * CHANNELS*) 


t,H(>  format  (1A4.) 
END 


floo 

floo 

FLOO 


\u 


i 
6 
6 

64 

65 
660 
670 

66 
69 


« 

rlo 

740 

750 


FILE:  FLTNUM 


C 

C 

C 


FUNCT I ON  FLTNUM ( C AftO t COL • NUHVEC * VECH AX ) 
IMPLICIT  INTEfiER  (A-M.O-Z) 


CALL. , 
ARCS.. 


FLTNUM { CARO  t COL  t NUMVCC  t VECMAX ) 


CAPO 

COL  _ _ 

NOeVEC  - BUFFER  IN  WHICH 
VECSIZ  - LENGTH  OF  NUHVEC 


• 62  COL  CARO  BUFFER 
— PTR  TO  FIRST  COL 


CARD  TO  SCAN 


Ti^RETURN  THE  NUMBERS 


REQUIRES.  NONE 


PURPOSE.. 


interprets  real  NUMBERS  SEP 
AND  RETURNS  THEM  IN  NUMVEC. 


RS  SEPARTEO  BY  COMMAS  ON  CARD 


STOPS  AT  first  •nonumeric* 
(NOTE.  NUMBERS  MAY  APPEAR  IN 

•DATA  STATEMENT  FORMAT* 

RETURNS..  COL  - COLUMN  WHERE  SCAN  TERMINATED 
NUMVEC  - VECiOR  OF  REAL  NUMBERS  FOUND 
FLTNUM  - NO  OF  PEAL  NUMBERS  RETURNED 


original  page  IE 

OF  POOR  QUALITY 


REAL  NUMVEC (20) .PNUM 
DIMENSION  CAR0(62) 

data  blank/*  */»COMMA/*,*/.PLUS/*^*/tMINUS/*-»/tSTAR/***/» 

1 PERIOD/*.*/,  7ERO/*0*/f  CROSIZ/62/  . 

LOGICAL*!  LLNIIM(l) 

LOGICAL*!  LNUM(4) 

DIMENSION  INUM(l) 

EQUIVALENCE  ( INUM ( I ) ,LNUM( 1 ) ) 

DATA  XX/ZOOOnOOFO/ 

DATA  LLNUM/ZOO/ 


L = COL^I 
VECPOS  = I 
10  MNIIM  = 0 
PCNT  » 0 
PNUM  = 0.0 
ITFP  s 1 
SIDE  = -1 
sign  = ♦! 

DO  60  COL=L,CROSIZ 
IF  (CA90(C0U .FQ. BLANK)  60  TO  60 
IF  (CaPD(COL) .EO.PLUS)  GO  TO  60 
IF  (CAPO(COL) .EQ. COMMA)  GO  TO  70 
TF  (CARD(COU .NE. MINUS)  GO  TO  20 
sign  = -SIGN 
GO  TO  60 

20  IF  (CARD(COL) .NE.STAR)  GO  TO  30 
ITFR  = WNUM 
WNUM  s 0 
PCNT  = 0 
PNUM  s 0.0 
SIDE  = -1 
SIGN  s ♦! 

GO  TO  60 

TP  TF  (CAPO(COL) .NE. PERIOD)  GO  TO  40 
SIDE  = 1 
60  TO  60 

4P  IF  (CARO(COL) .LT.ZERO)  GO  TO  90 
INUMn)sCAWO(COL) 

LNUM(4)=LNUM(1) 

LNUM(l)=LLNljM(l) 

LNUM(?)sLLNUM(1) 

LNUM(3)=LLNUM(1) 

MORNUMsINUM ( 1 ) -XX 
IF  (Slf'E.LT.O)  GO  TO  50 
PCNT  s PCNT*! 

PNUM  s MNUM*MORNUM*(0.1**PCNT) 


FLTOOOlO 

FLT00020 

FLT00050 

FLT00060 

FLTOC070 

FLT00080 

_FLT00090 

IFLTOOlOO 

fltooIio 

FLT00120 

FLT00130 

FLT00140 

FLT00150 

FLTOOUO 

fltooIto 

fltooIbo 

FLT00190 

FLT00200 

FLT00210 

FLT00220 

FLT00230 

FLT00240 

FLT00250 

.FLT00260 

IFLT00270 

FLT00280 

FLT00290 

FLT00300 

rLT00310 

FLT00320 

FLT00:j30 

FLT00340 

FLT03350 

FLT00360 

FLT00370 

FLT00380 

FLT00390 

FLT00400 

-FLT004I0 

FLT00420 

FLT0043C 

FLT00440 

FLT00450 

FLT00460 

FLT0047C 

FLT004R0 

FLT00490 

FLT00500 

FLT00510 

FLT00520 

FLT00530 

FLT00540 

FLT00550 

FLT00560 

FLT00570 

FLT00S80 

FLT00590 

FLT00600 

FLT006I0 

FLT00620 

FLT00630 

FLT00640 

FLT00650 

FLT00660 

FLT00670 

FLT006B0 

FLT00690 

FLT00700 

FLT00710 

FLT00720 

FLT00730 

FLT00740 

FLT00750 

FLT00760 

FLT00770 

FLT00780 

FLT00790 


FILPt  FLTNUM 


I 


GO  TO  60 

SO  WMIIM  • |0*WNUNoM0RMUM 
60  CONTINUE 

COL.;  C»0Sl?4l 
«0  TO  QO 

70  vrcFlN  B VECPOS*lT|R-l 
IF  I vfcfin  .ot.  vIcmax 
00  FO  I«V£CPOS«VECFIN 
AO  NU**VFC(IJ  ■ SIGN«(W.NUM*PNUH) 


) VECFIN  » VECHAX-1 


VECp8i*‘r*VECF'lN4l 
IF  CVECPOS.LE.VEC^ 


-”***  TO  10 

GO  TO  no 
90  COl.  » COL-1 

VECFIN  « VECP0S*ITER-1 

IF  ( VFCFIN  .6T.  VECHAX  ) VECFIN  » VECMAX  

DO  100  I=VECPOS«VECFIN 
100  NUMVECm  « SI6N*(WNUH«PNUM) 

110  FLTNUH  B VECFIN 

WRITE (6.706)  (CAPO(K) *K»1«6?)«  COL. FLTNUM, (NUNVEC (K) fK*l tFLTNUM) 
706  F0PM«T(*  FLTNUM  ENTERED'/i  •.  62AI.I10/*  * . 15.20F8.2,/*  »»10F8.2) 
RETURN 
END 


FLT00800 

FLTOOOIO 

FLT00820 

FLT00870 

FLT00880 

FLT00890 

FLT00900 

FLT00930 

FLT009A0 

FLT00950 

FLT00960 

FLT00970 

FLT00980 

FLT00990 

FLTOIOOO 

FLTOlOlO 

FLT01020 

FLT01030 


file:  fsrsfl 


SUBROUT 1 NE  FSBSFL (UNIT»F1LE*ISTAT) 
IMPLICIT  INTEGER  <A-Z» 

N*0 


|f  jFlLEl.EO.  0)  RETURN 


40 

SO 


ISTAT  . 0 

( FILE  ;LT,  b)  60'Td  100 

MOVE  UNIT  FORWARD  N E-0>F*S 

read (UNIT *END>S0) 

GO  TO  40 
N > N * 1 

IF  ( N .E(S.  FILE)  RETURN 
60  TO  40 


100  WRTTE(ft.nO) 

no  FORMAT  (•  FSBSFL  ONLY  SKIPS  FORWARD*/) 
ISTAT  s 2 
RETURN 

END  . 


FSROOOlO 
FSB00020 
FSB00030 
FS600040 
FSB00050 
FSB 00*60 
FSB00070 
FSBOOOaO 
FSB00090 
FSBOQIOO 
FSBOOllO 
FSB00120 
FSB00130 
FS600140 
FSB00150 
FSBOOUO 
FSB00170 
FSBOOIBO 
FS800190 
FSB00200 
FS0OO21O 
FSB00220 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


1^1 


FILF*  FSFHFL 


40 

30 

50 


PSFMFLIUNIT.FlLEflSTAT) 
IMPLICIT  INTEGER  (A*2) 

N«0 

fSTAT  « 0 

it  .EO,  0)  RETURN 

IF  ( FILE  .LT.  0)  60  TO  100 

MOVE  UNIT  FORWARD  N E-O-FtS 

REAO(UNlT«3QtEND«50) DUMMY 
FORMAT  1 1A4) 

GO  TO  AO 
N « N ♦ 1 

IF  ( N .EQ.  FILE)  RETURN 
60  TO  40 


100  WRTTE<6.110) 

no  formatj*  fsfmfl  only  skips  forwaro*/) 

ISTAT  « 2 
RETURN  , 

END 


FSBOOO] 
FSBOOOi 

riisslh 

FSB00050 

FSB00060 

FSB00070 

FSBOOORO 

Fseoof 

FSBOO] 
FSBOO 

fsbooL 

FSB00130 

FSB00140 

FSBQOISO 

FSB00160 

FSB00170 

FSBOOISO 

)i|8Si)g 

FSB00210 

FSB00220 

FSB00230 


yo  V' 


FILE!  CETINF 


C 

C 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


90 


SURROUT I NE  GET  INF ( ARRAY  * FLOS A V t VERTE  X . CLSNMS • NOSUBS  t SUBNH  t NOCLS  t 
» TOTSU8) 

IMPLICIT  INTEGER  IA-2) 

DIMENSION  ARRAY ( 1 ) *FLOSAV ( A* 1 ) • VERTEX ( 1 ) *CLSNMS ( 1 ) tNOSURS ( 1 ) * 

» SURNM(l) .CLSVEC(60) 

JJ  = 0 
KPT  = 1 
NFS  » 0 
L * 0 

SEE  SUBROUTINE  RODATA  FOR  STORAGE  ARRANGEMENT  OF  »ARRAY» 

00  80  CLSsltNOCLS 
L = L ♦ NFS 

CLSNMS (CLS)  s ARRAY (KPT) 

NOSUBS (CLS>  = ARRAY (KPT^Z) 

NFS  = ARRAY(KPT^3) 

IKP  a KPT  *4 

no  100  lalfNFS 
FLnSAV(l,I*L)  a ARRAY(IKP) 

FLnSAV(?,I*L)  a CLS 
FL0SAV(3» I»L)  a 0 
FLnSAV(4»I*L)  a ARRAY(IKP*1) 

NV  a FLDSAV(A.I^L)*2 

no  90  Jal.NV 

VERTEX (JJ*J)  a ARRAY(IKP*1*J) 

JJ  a NV  ♦ JJ 


100  CONTINUE 

IKP  a IKP  ♦ NV  ♦ 9 
KPT  a ARRAY(KPT*l) 
80  CONTINUE 


K a 0 

no  120  lal.NOCLS 
NSU0  a NOSURS(I) 

no  120  Jal,NSUB 
K a K ♦ 1 
120  CLSVEC(K)  a I 

CALL  NAMSTA(SUBNM,CLSVECfN0SUBS»T0TSU8. CLSNMS. NOCLS) 

return 

ENn 


FILE I 6ETST 


sy‘*5pyi*'^l  <UNlT,FlLe»MENS.ST0EV.N0SU82tSUBVECtN0CHAN, 

• CHNVECtHEANStCOVARtlTRIG) 


GETOOOlO 

GET00020 

GET00030 


C» 

C* 

c* 

c* 

c*. 

c* 

c* 

c* 

c* 

c* 

c* 

c« 

c* 

c* 

c* 

c* 

c* 

c« 

c* 

8: 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c» 

c* 

8: 

c* 

c* 

c* 

c* 

8: 

8: 

c* 

c* 

c* 


c* 

c* 

c** 

c* 


SUBROUTINE  6ETSTA  RETRIEVES  THE  MEANS  AND  STANDARD  DEVIATIONS 
FROM  A STATISTICS  FILE  IN  THE  LARSYS  »SAVTAP»  FORMAT, 

INPUT  ARGUMENTS! 


UNIT 

FILE 

NOCHAN 

CHNVEC 


-^FORTRAN  UNIT  NUMBER  FROM  WHICH  THE  STATS  ARE  TO  BE 
RETRIEVEO, 

- FILE  NO.  ON  ‘UNIT*  FROM  WHICH  THE  STATS  ARE  TO  BE 
RETRIEVED, 

- NO.  OF  CHANNELS  REQUESTED  FROM  TRAINING  SEGMENT, 
NOCHAN  LESS  THAN  OR  a NO,  OF  CHANNELS  ON  STAT  FI 

- ARRAY  containing  ACTUAL  CHANNELS  REQUESTED  FROM 
training  segment,  must  BE  A SUBSET  OF  CHANNELS 
ON  STAT  FILE 


LE 


ITRI6  - IF  ITHIG=1»  ST.  DEV.  WILL  BE  RETURNED  ALONG  WITH  MEANS 
OUTPUT  ARGUMENTS! 


MENS 


STOEV 


NOSUR 
CONTINUE 
CHNVEC  - 


- array  CONTAINING  THE  MEAN  VECTORS  FOR  EACH  SUBCLASS 

( A SUBSET  OF  THE  CHANNELS  MAY  BE  SELECTEO*  BUT  NOT 
A SUBSET  OF  THE  SUBCLASSES), 

- ARRAY  CONTAINING  THE  SUBSET  OF  ST.  DEV.  FOR  REQUES- 

TED CHANNELS  IN  EACH  SUBCLASS 
IN  EACH  SUBCLASS. 

- number  OF  SUBCLASSES  ON  THE  STaT  FILE 

ARRAY  CONTAINING  ACTUAL  CHANNELS  REQUESTED  FROM 
TRAINING  SEGMENT 


GET00070 

GETV0060 

GET00090 

6ET0A100 

GETOOIIO 

imm 

GETOOlAO 

getooIto 

GET00180 

GET00190 

6ET00200 

,6ET00210 

GCT00220 

GET00230 

6ET002A0 

GET00250 

getooHo 

GET00270 

6ET00280 

6ET00290 

6ET00300 

6ET00310 

6ET00320 

GET00330 

GET003A0 

*61 


GET00380 

••NOTE**  the  STORAGE  ARRAYS  PASSED  TO  THIS  SUBROUTINE  FOR  THE  GET00390 

MEANS  AND  standard  DEVIATIONS  SHOULD  BE  SINGLY  DIMENSIONE06ET00400 
IN  THE  CALLING  ROUTINE.  ON  OUTPUT  THE  ITEMS  ARE  STORED 
AS  FOLLOWS:  <SAME  FOR  STOEV) 


CONTINUE 


(1) 

- 

CHANNEL 

(2) 

CHANNEL 

3 

• 

CHANNEL 

(NOCHAN) 

(NOCHAN,) ) 

m 

CHANNEL 

(N0CHAN*2) 

CHANNEL 

(NOCHAN, 3) 

• 

a* 

CHANNEL 

(2*N0CHAN) 

• 

- 

CHANNEL 

• 

ETC. 

THRU 

' 

If 

2f 

3f 


SUBCLASS 

SUBCLASS 

SU8CLAS§ 


6ET00A1O 
6ET00420 
6ET00430 
GET004A0 
6ET00450 
:T00460 
iT00470 


NOCHAN, SUBCLASS 

1,  SUBCLASS  2 

2,  SUBCLASS  I 

3,  SUBCLASS  2 


NOCHAN  OF  SUBCLASS  2 


^^00480 


(NOCHAN*NOSUB) 


100 


IMPLICIT  integer  (A-Z) 

DIMENSION  Ch-NVCI  (30)  f0UMVEC(30)  fCHNVEC(l) 
DATA  BLANK/'  •/ 

DIMENSION  SUHVEC(l) 

DIMENSION  meaNSO)  .STDEVU) 

PEAL  MEANS. STOEV, C0VAR(465) 

REAL  MENS(l) 

REWIND  UNIT 
NFa^LE-l 

CALL  FSBSFLCUNIT.NF.ISTATI) 
lF(lSTATl.t).0)G0  TO  S 
WR1TE(6.100»UI4IT.F1LE 

FORMAT (IX, 'ERROR  IN  POSITIONING  UNIT', 13,' 
CALL  CMERR 


TO  FILE',  13) 


6E 

6E  . 
6ET00490 
GET00500 
GET00510 
GET00520 
6ET00530 
GET00540 
GET00550 
GET00560 
GET00570 
6ET005B0 
GET00590 
GET00600 
6ET00610 
GET006PO 
GET00630 
'GET00640 
GET00650 
6ET00660 
GET00670 
GET00680 
GET006R0 
GET00700 
GET00710 
Gf  T00720 
GET00730 
GET00740 
6ET007S0 
GET00760 
GET00770 
6ET007BO 
GET00790 


FILE:  GETST 


rONTlNUF 

PEAO(UNIT)NOCLSfNOSUB*NCHAN,NOFLO«TOTVRT«  <CHNVC1 ( 1 > tl>lf NCHAN) 

DEFAULT  ALL  SUBCLASSES  FROM  STATISTICS  FILE 

IF(NOSUB2.NE.0)6O  TO  7 
no  6 I«l. NOSUB 
SURVFC(I)«I 
N0SUB2*N0SUB . 

CONTINUE 

no  77  Tsl.NOSUBZ 

IF  (SURVECn)'  .LE.  NOSUB)  60  TO  77 
WRTTF(<S.70)N0SUH 


6ET00800 

getoobIo 

6ET00820 


DNOSUH 


NOSUB)  60  TO  77 


6ET00830 

6ET00840 

6ET00850 

GET00880 

6ET00870 

6ET00880 

GCT00890 

GCT0Q90Q 

6ET00910 

6ET009|0 


format (/•  REQUESTED  SUBCLASS  IS  NOT  ON  STAT  FILE,  STAT  FILE  CONTAI6ET009 


♦NS  SUBCLASSES') 

CALL  CMERR 
r CONTINUE 

DEFAULT  — ALL  CHANNELS  FROM  STAT  FILE 
IF  (NOCHAN  .NE.  0)  60  TO  9 

no  a 1=1. NCHAN 
CHNVEC(I)  = CHNVCl(I) 

NOCHAN  * NCHAN 
CONTINUE 

READ  PAST  THE  TRAINING  FIELD  INFORMATION 

no  in  Irl.NOFLD  • 

READ (UNIT) DUM 
PEAO(UNIT)DUM 
) CONTINUE 
READ<UNIT)OUM- 
VAPSIZ  * NCHAN* (NCHAN*l)/2 
HB=1 

ME  = NCHAN 


IC=1 

no  30  I=1,N0SU« 

RF40(UNIT)  N, (COVAR(J) ,J=1,VARSIZ> , (MEANS(J) ♦J»MB,ME) 
IF(SURVECnC)  .NE.I)60  TO  30 
IFdTRlG.NE.DGO  TO  25 

GET  standard  DEVIATIONS 

vJK=0 

no  20  ja*i,nochan 

JK=  JK*  JA 

STnFV(MR*JA-l)  » S(3RT(C0VAR(JK) ) 

CONTINUE 
CONTINMF 
IC  = IC  ♦ 1 
MB  = MB  ♦ NCHAN 


ME  = ME  ♦ 
CONTINUE 

get  SUBSE 
AND  GET  SI 


NCHAN 

NCHAN 


T OF  means 
U8SET  OF  ST.  DEV. 


no  50  J=l. NOCHAN 

no  40  Ksl, NCHAN 

IF  (CHNVEC(J)  .EO.  CHNVCl(K))  GO  TO  50 
CONTINUE 

WRITE  nO)CHNVEC(J)  . (CHNVCl  (L ) »L»l  .NCHAN) 
FORMaTC  CHANNEL  NO.  ',12.'  IS  NOT  ON  TRAIN 


I format (•  CHANNEL  NO.  ♦ 
1 ARE  •/  10X.30(I2,1X) ) 
CALL  EXIT 
I OUHVEC(J)  s K 


IS  NOT 


JJJ  « 0 

no  60  Kxl,N05UR2 

DO  60  Jsl.NOCHAN 

JJ  = Dt)MVEC(J)  ♦ (K-1)*NCHAN 

JJJ  * JJJ  ♦ I 

MENS (JJJ)  = MFANS(JJ) 

IF  ( ITRI6  .NE.  0)  STnEV(JJJ) 
WOITP (6.200) 

FOPMiT (//T57. 'MEANS') 

ISTAPT  = 1 
lENO  a 12 


GET009A0 

GET00950 

6ET00960 

GET00970 

iT  FILE  6ET009R0 

GET00990 

GETOIQOO 

GETOlOlO 

GET01020 

GETOIOSO 

ORMATION  GET01060 

GET01070 

GETOlOeO 

6ET01090 

GETOllOO 

GETOlilO 

GET01120 

GET01130 

GET01140 

GET01150 

GET01160 

GET01170 

Z) , (MEANS(J) *J=MB,ME)  GETOllBO 

GETOllPO 
GET01200 
GET01210 
6ET01220 
GET01230 
GET01240 
GET01250 
GET01260 
6ET01270 
GET012B0 
GET01290 
6ET01300 
GET01310 
GET01320 
GET01330 
GET01340 
GET01350 
6ET01360 
GET0I370 
GET01380 
GET  01 390 

0 TO  50  GET01400 

GET01410 

.L»l. NCHAN)  GFT01420 

lOT  ON  TRAINING  STAT  FILE.  CHAHHELSGET01430 

GET01440 
GET01450 
GET01460 
GET01470 
GFT014B0 
GET01490 
GET01500 
GET01510 
GF.T  01520 
GFT 01530 

STOEV(JJ)  GFT01540 

GF.T  01550 
GET01560 
Gf  T01570 
GET01580 


FILFt  GETS! 


210 


220 


250 

23S 


2*0 


loopct 

• MOD (NOCHAN. I 9) 

CT.«  LOOPCT  ♦ 1 

Tend  > nochan 

PNO  ■ TEND 

FnPMlT^/ii®*JPhS5!SS?^2y^?4U:*"lSTART,IENO) 

START  ■ IStART  ♦ NOCHaN*D 
FNO  ■ lENO  ♦ N0CHAN*J 
CONTINUE 
WgfTE(6*235) 

FORMAT (/T 

ISTART  » lENO  ♦ 1 

if'^O  ■ lENO  ♦ ISTART  - 1 

CONTINUE  *^*^0  « NOCMAN 

return”^ 

ENO 


t-A^rfe  i;S 


FILE!  6RFSCN 


pENO 


TNCLUOE  COMPKiaiST 
COMMON/1NFORM/NOCL§2«  _ 

ftVAHP.COVA^P.CL^ 
FETVC2O0)  .SUBVC2<? 
KfPPTS<60)  «NOGRP»6HI 
6HPCHK (61) .GR0UHS(124) 


2iNpSyR2.NOFET2fVARSZ2»TOTyT?iNOFLn2. 

‘ ^"TiSUBPTRCTSliCL.  _ 
NAM (60) tGRPOEAlGl) « 


SUBN02.SUB(DS2»Fl0SV2,VERTX2. 
) »SUBPT«1I§) ♦CLSVC2(60) * 


C 

C 


C 

c 


c 

c 


FUNCTION  ORPSCN(CARO*NNCLAStORPTR)  ORP00020 

— — — — .-ilSpooolo 

....  .......  — - ...  ............T 

............................. .... ..................^....fSppodoio 

..................................................................igrpoootq 

I6RP00060 

CALL..  CALL  GRPSCN (CAR0*NNCLAS«6RPTR)  I9SS9S9SS 

IGRPOOIOO 

AR6S..  CAPO  -'62  COL  CARO  BUFFER,  , IGRPOOnO 

NNCLAS  - MAX  NO  OF  CLASSES  TO  ALLOW  iGRP05i|o 

GRPTR  - PTR  TO  • GROUPS' 

IGRPOOlAO 

REQUIRES.  COMMONS  /INFORM/  /INFORS/  /0I5C0M/  I®fi552l®2 

ROUTINES  NXTCMR  FIXUP  NUMBER  l§55S5t§2 

IGRPOOltO 

PURPOSE..  SCANS  ALL  'GROUP*  (TRAIN/TEST)  CAROS  l§S5S$il2 

AND  SET  UP  *6RP0EX*«*GRPNAM*. 'GROUPS' 

IGRP00200 

RETURNS..  GRPTR  - SEE  AR6S  |6RPOO|iO 

(GRP00240 
GRP00250 
GRP00260 
GPP002TO 

GPP00300 
GRP00310 
GRP00320 
GRP00330 
6RP00340 
GRP003S0 
-GPP00360 
GPP 00 370 
GPP00380 
GRP00390 
GRP00400 
GRP00410 
GRP00420 
6RP00430 
GPP004A0 
GRP00450 
GRP00460 
GRP00470 
-6KP00480 
•GPP00490 
GRPOOSOO 
GRPOOSIO 
GRP00520 
GPP00530 
GPP00S40 
GRP00550 
GRPO0S6O 
6RP00570 
GPPOOSAO 
GPP00590 
GPP00600 
6RP00610 
GPP00620 
GPP00630 
GPP00640 
GPP00650 
6PP00660 
GMP00670 
GWP00660 
GPP00690 
GPP00700 
GPP00710 
GBP00720 
GPP00730 
GPP007<»0 
GPP00750 
GPP00760 
GPP00770 
r.WP0U7fl0 
GMP00790 


10 

2ft 

30 

40 

SO 


DIMENSION  8UF(A),  CAR0(62)»  C0MVEC(2).  NUMVECOO) 
L06IC6L*1  LCMAR(4) 

DIMENSION  ICHAR(l) 

FOUIVAlENCE  (LCHAR(l) .ICHAR(l) ) 

LOGICAL"!  LLCMAR(4) 

DIMENSION  IlCHAP(l) 

EOUIVALENCE  (LLCHAH(I) fllCHAfld) ) 

DATA  BLANK/'  */.  COMMA/'**/.  COMVEC/1. * • '/ 


COL  * ft 
GRPSCN  » 1 

J s NXTCHR(CARO»COL) 

IF  (J.FU. BLANK)  GO  TO  110 

DO  10  Isi.4 

J2  = CAPC(CnL“l*I)  _ 

IF  (J2.EU. COMMA)  GO  TO  20 
PUF(I)  a J2 
GO  TO  40 


7ft 


no  30  Jal,4 
BUF(J)  a BLANK 

N a ABS(O.O) 

no  50  iai.4 

lICHAR(l)aBUF(I) 

LrMAP(I)aLLCHAR(l) 

wRDIbIChak(I) 

GRPNAM(N0GRP*1 ) a WROl 
J a FIN012(CAP0.C0L»C0MVEC) 

IF  (J.LE.O)  60  TO  110 
J a N(JMBER(CARO*COL*NUMVECtO) 

II  a 0 
last  a 0 

no  90  lal.J 

IF  “jJ^GTaUl, AND.  JJ.LE. NNCLAS. AND. GRPCHK(JJ)  ,EQ.O)  GO  TO  AO 
WRITF(A.  70)  JJ.  JJ.  CARD  , „ 

format (//  5X»  */////  FROM  SUBR.  GRPSCN  — CLASS  '.15. 


riLCt  GRnCN 


^18  j 

t/CORRFCT 

GO  TI  ■ 

lf®l 

NUMV 

GRPC 

EClltl  ■ 
hkIjj)  ■ 

■ JJ 

INUf 

ll.LE.O) 

CLASS 

62A1* 


•*ISt*  lONOREO* 
2H»i  /» 


// 


100 


no 


nX««CARD  BEING  SCANNGRPOOSOO 

GWPC 

GRP  2 
6PP( 

GNPC 

gpp2  . 

GRPO( 


GO  TO  110 


^RP  ■ N0GRP«1 
»TR  « GRPTR'  ♦! 
>OEX(NOGRP)  ■ 


NOGRP 
GRP  “ 

GRR_.  . 

GROUPS (GRPTRt 
no  100  l«lill 
GROUPS  1 6RPTR»n 
GRPTfi  ■ GHPTR^II 
GRPSCN  so 
RETURN 


|RPTR 


NUHVECm 


GRP009GO 

GRP0OV7O 


GRP009BO 
6RP0099 


RETURN 

END 


GRPOl 
GHPOio] 


GRPOlOi 


FlLEt  HIST6M 


^unnouTiNE  mi^tgh»filmis*flotal*tott*u 


Pu.P«f  - sisjoyR.-!  ijo^wRjTjg  {?'5j,.?irsS8JfSI8. 


IMPLICIT. INTEGER (*-T» 


INCLUD 

iNCLUn 

INCLUD 

COMMON 


COM^lO.LlST 

C0MHK4.LIST 


V.NOHIST* 


^«ENO 


C0MHK6*LI5rr 

/6RCRLK/MAXFET,N0FEAT.N0FET2.FETVFC( 

F£TVC2<30) ,FL0INF(6>.INFmT.F] 

• HlSVECnO)  tNOFLOt  i 

••X^TZ«XLOtM«XHGH,YSIZ 

DIMENSION  hEDI  (15)  .HED2nS)  tOATE  (3)  «COMENT(15) 
equivalence  (Mfc01(l)iMEA0(A))f  (0ATE(l)*MEAD(22n«  . 

2 (MEO2<l)tMEAD(30))»(COMENT(l) tHEAOCASn 

C0MM0N/6L0BAL/mRAD(63) ♦MAPTAP.DATARE»SAVTAP«BMFILEi»MKEYj(,. 

• HlSFIL.MlSKEY.IRFORM.ERIPTP.ERPXEY.MAPUNTtNOFILEf 

• DRUMAD.DRM'RUS.PAGSIZ*OAtFIL»StAFIL«ASAVfASAVFL 

• .NHSTUN»NHSTFI«SCTP0N.MAPFIL  ^ ..  , 

• .nOTUNTtOOTFlL»NCMPAS»TRNSFLtBHTRFL*HISTFL»PCMUNTt 
CR0UNT.PRTUNT*RANDI0 


Jal.XSIZ 
■ WOHlST 

« n 

« 0 


c 

c 

c 


COMMON  /HISTOR/MF 

INTEGER  XSI7tYSIZ.XH6H*XL0W 
INTEGER  vewTCS 

niMENSION  ir>»TA  (12000)  .EILHISCNOEEAT. 256)  

• ELDTaL (NOHIRT.XSIZ) «T0TTAL (NOMlSTtXSlZ) *IFLO(50»2A) t 

• VERTCR{?.11) »EL(G) 

OATA  RLANK/i  »/«OIM/12000/ 

DATA  TOTAL/*TOTA*/ 

FQUI valence  (ELOINF (1 ) .LINSTR) * (FL0JNF(2) •LINENO) « 

• (ELOINF (1) »L ININC) f (ELD  INF (4) iSAMSTR) « 

• (FLOINE (5) rSAMENO) • <EL0INE(6) .SAMINC) 

CA|,L  TAPH0R(DATAPE*DATFIL) 

HI<KEY»1 

eIlfsv  s 0 

ISwTh 

no  7 

DO  7 I«1 

ELDTALd.J) 

T T0TTAL(I*J) 

NOELDaO 

IE(HF,N£.l)  GO  TO  10 
NCaS 

VERTCRIltl)*! 

VEOTCS(?.l>»i 
VEBTrS(l«2)*200 
VE»TrS(2.2) »1 
VEBTCS(l#3)s?00 
VEOTrS(?.3)aS00 
VEPTf,S(l  .4)»1  ' 

VEBTCS(2r*)»500 
VERTCS{)«S)=1 
VEPTrS(2»i) =1 
ELnNAMaRLANK 
FLniNF(l)al 

ELDJNE (2) asno 

ELniNF(3)alO 
FLDINF(/*)  al 
ELniNF (S) *200 
ELnlNE(^,)al0 
GO  TO  15 

READ  IN  field  CAPOS 


10  ICFa(.AREAD(FLDNAM,  VERTCS«FLOINF*NC) 
IF(irK.K).l)  GO  TO  15 
fE(irK.EO.O)  on  TO  60 
IF ( f EK  ,LE  •-! > GO  TO  10 

15  NSAHP  a ( FL0INF(5)  - FLOINF(A)  ) / FL0INF(6) 


1 


m^v 


CHECK  data  DIMENSIONS,  IF  TOO  MUCH  DATA  REQUESTED*  RESET  SAMPLE  EN 
TOTPTS  s NSAMP»NOFEAT 


M1S00270 
S00280 
S00290 
S00300 
S00310 
S00320 
S00330 
S00340 
S00350 

188m 

S003R0 

inin 

.SOOAlO 
IS00420 
S00430 
S004A0 
S004S0 
S00460 
$00470 
SOO40O 
S00490 
S00500 
S00510 

soof 
soo* 
sooj 
soo| 
sool-- 

S00570 
SO05P0 
S005RO 
S00600 
.S00610 
MI500620 
S00630 
S00640 
S00650 
S00660 
500670 
S00680 
S00690 
S00700 
S00710 
S00720 
S00730 
,$00740 
HiS00750 
HiS00750 
}Hisort770 
MISO0780 
H1S00790 


I 


1 

i 


19:^3^ 


non 


FlLEt  HIST6M 


IF  ITOTPTS  .WE.  OlH)  GO  TO  14 
NSAHP  > plto  / NOFEAT 
F|^n|NF(sT  ■ INSAMP-l>*FLOINFC6) 


_ ..  _ FLOINFU) 

300  FoiHAlM^?So  MuSh^OATA  HEOUESTEO  — SAMPLE  END  MAS  RESET  TO*»IS/) 


STORE  FIELD  ^‘'FORMATION 


14  NOFWn  • NOFLO  ♦ 1 
TFfNOFLD.6T.50)  F 
IF (NOFLO. 6T. 50) 
KbO  , 

00  100  Jal.lO 

no  100  1*1«? 


101 

10? 


100 


FL0(n0FLD.??)«SAM|NC 
FLO (NOFLO* ?3)>LiNiNC 
K0(N0Fl6*?4)«NC 


19  CONTI NUt 

ISWTH  ■ ISMTH 


♦ I 


zero  out  part  of  field  HISTOGRAM  ARRAY 

no  ?0  I«l*NOFEAT 

DO  ?0  Jb!,?56 

?0  FILHlSd.J)  > 0 

5CALK46  FACTORS  USED  FOR  PLOTTING  ROUTINE 


XSCALE  » 
XSMFT  * 


PRINT  FIELD  STATS 


float <1-XSIZ)/(XH6M-XL0M) 
-XM6M*XSCALE  * 1.0 


CALL  FLOINTfFLOlNF.FETVEC. NOFEAT) 

LINES  «(FLOINF(?)-FL01NF(1)  ) / FLOINFO)  ♦ 
F^DPTS^O 


30  1»1. LINES 

N B 1 

CALL  LINEROdliATA.ENOTAP) 
IF  (ENOTAP  .NE.  0»  GO  TO 
IFd.NF.l)  '••0  TO  101 
ITbLINSTH 
no  TO  10? 

II»I1*L1N1Nv 

CALL  FDLINKVERTCS.NC 

MC«0 

DO  30  jBl, NOFEAT 

LbI 

no  34  kkbi.nsamp 

KPTs (KK-1 ) bSAMILC^SAMSTR 

no  103  jK»u»JJ»? 

1F(KPT.LT.FL(JK) J GO  TO  34 
IF(KPT,6T.FL(JK*i) ) GO  TO 
IF(J.EQ.l)  FLOPTSsFLOPTSd 
IPOS  » (J-n*NSAwP  ♦ KK 
K B lOATAdPOS) 

IF  (K  .LT.U  K b \ 

FILHIS(J.K»  = FILHIS(J.K) 
IF(H1SVEC(N).NE.FETVEC(J) > 
KC»1 
>UT 


33 


*FL«11*NS*JU) 


105 


GO  TO  34 


XSHFT  • 0.501 


IPUf  » lOATAdPOS)  • xscalf 
If  dPUT  .lt,  n iput  « i . 

IF  (IPIJT  .GT,  XS17)  fPUT  « XSIZ 

FL''TAL(N.1»IIT)  b FL0TAL(N,IPUT)  ♦ 1 
TOTTA|.(^•,iPllT»  B 1 . TOTTAL(N.IPUT) 

IF  (KK  ,EO.  NSAMP)  N B N ♦ I 
r»0  TO  34 
105  LbL*? 

IF (L.GT.JJ)  60  TO  106 
103  rONflNUE 
34  rONTINtlF 

IF  (KK.F(J.NSAmP)  CO  TO  30 


105 


30 


CONTI  N(»F 
IF(KC.EO.l) 
KC»0 

CONTINUE 


NbN*1 


(00800 

local 


»0089( 


\init 

>00990 

>01000 


I! 


170 


H1S01S40 


riLCi  HISTOM 


33 


? 

C 


CONTINUE 
TO  ■ 0 

CALL  HlSTlC(riLH|S,lP,lfLD.  VEOTCS.NC) 

wRlTrCHlSFIU  MriLHl?;UiJ1  .J*1«256)  *1«1.N0FCAT» 
!F(MF,F0.1)  00  TO  60 
If  (NOHIsf  .EO.  0)  CO  TO  10 

CALL  PL0TTIW6  ROUTlNf  To  PuOT  HISTOOPaM  FOP  THE  FIELDS 

H':TCRH(rL0TAL<IOATA.FLONAMt2fXSIZ«XHGH*XL0WfYSIZt 
- *LOPTS.*^iSVtCi 


8 

C 


call  M'tr 

►NOHliT.? 
CO  To  10 


WRITE  TOTAL  HIST  ON  TAPE  —UNIT  13 


60 


104 


INUE 

NO  HISFIL 

■1. NOFEAT 


no  10*  I«l. 
no  104  v«l*2S6 
PILHIS(I.J>«0 

no  107  K-l.NOFLO 

JK»N0FFAT*266 

dEAD(hIsFIL)  (lOATA(l) *I>1*JK) 
Man 


no  10«  l«l«NOFEAT 

no  loa  j«It2'>6 

MsM*] 


lOA  FILHIs (If J>>I0ATA(M) *FILHIS(If J) 
107  CONTINUF 
PEwp 


nofeat,  (FETVECCI) f 1«1,N0FEAT) 
((FILHiSUf  J>  fU*lf2S6)ft>lf NOFEAT) 


.'wind  HlSFIL 
WRltF  (HISFIU 
wRITf  (MISFIU 
rewind  HlSFlL 

PRINT  total  stats 

TP  * -1 

call  HlSTIC(riLHlSf IPfIFLOf  VERTCSfNC) 

IF  <nO«IST  .pq,  0)  WETURN 
IF  (NOFlu  fti'J,  i)  RETURN 

CALL  plotting  routine  TO  PLOT  TOTAL  MISTOGRAN 

CALL  HSTGRM(T0TTAL , I0ATA,T0TAL ,3, XSlZfXHGH, XLOWtYSlZ, 
•NOwISTfFLOPTSfHlSVEC) 

PFTURN 

200  F0OMAT(13AN.A2) 

END 


ITIS 

m 

1730 

1740 

1750 

1760 

1770 

17«0 

[790 

1800 


1850 

lit: 
1880 
1890 
>01900 


Hi 


[S01930 
[S01940 
1950 

III! 

isoiooo 

[S02010 

S02020 

IS02030 

S02040 

1S02050 

IS02060 


OWCI  oouuv  wo  oO 


riLFl  MI5TIC 


^i: 


SU^POUTI^E  MISTIC I IHO.NI f iriOf  VCPTCSfNC) 


.CO 


41 


CCyOP  Com*4«^JlIst 
mmon  /$RcnLK/MAxri 


:0MRK3, 

*0MHK«4 


•fXSIZ. 

ni*»EN5 

POUlVA 


hTsv. 
XLOw**HfiH,ysrz 


«N0HIST« 


!0N  MCm  (15J  jHCOZUR)  ,OATE(31»COMfNT(15> 

(HEOl  (1)  *h|a0(4)  ) • (0ATE(n«HEA0i22l ) * 


CSEND 


__  VALENCE 

? <H€n?<n  .mCao(30)  > t «coMENT(i).MCADiA(i)  > 

COMMON/GLOBAL/HEAnibS) .HAPTAP.UATAf>E*SAVTAPtHMriLEfBHKEYt 

• MlSFlL»*il5KEY»TProPHitR!PTP.EBPKEr.MAPUNT«NOriLE. 

• f)*»(IMA0»f>»*»'V0SfPA6SlZt0ATFIL»STArfL«ASAV.ASAVrL 

• .NH^TUN*N*<5Trit^CTNUN»MAPFlL 

• .r)OTUNT,DQTFlLtNCMPAS*TPNSFL«l 

• C»DUNT*PRTUNTt«ANOIO 


»BHTRFLtHlSTFLtRCMUNT» 


C 

I 


70 


TS 


DIMENSION  RANGE  (30.2)  ♦?rtEAN(30»i  STDOEVOO) 
* NOANGr (30.2) .iMGtNOFEAl *2S6) . IFLO(50.2*) 
tNTFGFP  VEPtCS(l) .OP.CR.COPMA 
data  OP/* (‘/.cp/') •/.comma/*.*/ 

TNTEGFP  FlOINF.FETvEC.MEAO.FIlESV 

real  npange 

computes  The  data  range 


no  JO  T 

no  2o  j 

1f^(IHG(1.J* 

PO  CONTINUE 

30  0tNC,e  (T.l)  ■ 

*f«PS7 


• 1. NOFEAT 

« 1.4 


>256 


.NE.  0) 


60  TO  30 


M 

:iH 

:Ih 

:!h 

H 

H 

H 

M 

H 

M 

H 

H 

H 

H 

H 

H 

M 

H 

M 

M 

M 

M 

rt 

H 

M 

M 

M 

M 

H 

M 

M 

H 

H 

H 

M 

H 

M 


40  **«K-1 

IF  (fl  . 

IF (K.GT.ISTR)  go  TO  40 


(!mG(1,K)  ,NE.0) 
K.GT,is“-  - - 

50  PANCiF  (1.2) 


GO  TO  so. 


COMPUTES 

The  MEAN  — (l/N)  • ( 1*»1HG(D*  2«*1M6(2)* 

•••  N*lMG<N)  ) Ml 

Ml 

STnnvi 

m 

0 

h1 

RME4N 

u 

0 

Ml 

N 

9 

0 

Hi 

no  60 

L ■ 1.2S6 

Hi 

N 

9 

iMGd.L)  * N 

Ml 

4MP  an 

9 

L«lMr,(I,L) 

Ml 

STnnw 

m 

AMFAN  • L 

M] 

RMPAN 

9 

AMPAN  . HMFAN 

Ml 

sinnvi 

9 

STnnv  ♦ sTOovi 

Ml 

7MPAN(I) 

■ wmpaN  / N 

Ml 

STnnv! 

9 

STOOVI  /N 

Ml 
. Ml 

COMPUTES  ThE  STO.- OEV,  — SORT,(  (1/N)«(1* 

2)  ♦ ...  < 

2 ) 

A s STOnV)  - ZMEAN(I)«»2 

STnOEV(I)  m SOPT(A) 

COMPUTES  NORMAL! ZEO  RANGE 


*2  *1HG(1)  * 2»«2  • )HG 
N*»2  • 1H6(N))  - MEAN* 


IP 


NPANGF (t.l) 
NWANC-E(  I .2) 
!N=NC-1 
NNC»2*(IN) 


» 7MEaN(I)  - 3»5T0neV(I) 
» 7MtAN(l)  • 3«ST00CV(i) 


WRITE (N.MEAn) 
IF  (M.EO.  -1) 
wMITE (4.510) 
no  70  11 

WPTU  (4.520) 


f-0  TO  A5 


urn  I j ■ 1 .NOFEAT 

pm  (4.520)  FF  1 vFC  ( 1 1)  . IFLn(N0FL0.21 ) . IN.FLOINF)*)  .FLniNF(3)  , 
( (OP.vt  PfCS( J) .COMMA, VEWTCS(J*1) ,CP) . J»1 .NN“,2) 

BITF (4.530) 


(M 


$00010 

0 

.6fi64§ 

soooso 

S00060 

S00070 

&OOORO 

$00090 

$00100 

SOOllO 

$00120 

S00|30 

$00140 

S00150 

$00160 

S00170 

$00180 

$00190 

S002C0 

S00210 

$00220 

Mh 

$00250 

$00260 


wo 

CONTINUE 


looHo 

S00300 

$00310 

him 

$00340 
$00350 
S00360 
.S00370 
M1S00380 
500390 
S00400 
500410 
$00420 
500430 
S00440 
S00450 
$00460 
$00470 
S00480 
$00490 
MIS00500 
Ml$00510 
H1S00520 
M1S00530 
500540 
SC0550 
S00560 
. .500570 
•HISO0580 
H1500590 
SOOhOO 
$00610 
S00620 
S00630 
SO0640 
S006SO 
SO0660 
500670 
S0()6«0 
S00690 
500700 
S00710 
5O0720 
500730 
500740 
.500750 
MI5O0760 
M15O0770 
m:$007PO 
Ml  500790 


FILPt  HISTIC 


no  no  13 

«0  WPTTf  (f-.54o)  _ 

(13)  «NRAN6i 


» 1. NOFEAT 
FErvEC(13>tRAN6E 
EnStl)  tNRANC 


n3«ntRAN6E(I3f2)*ZMEAN(I3)  t 
E(I3t2) 


•STDOEV 
RETURN 
AS  WWTTF(4,550» 

IF (N0FL0.6T. 50)  NOFLOsSO 
no  1 l*l.NOFLO 
lNalFL0U»24T-l 
NNC»IN*2 

KJain  ■ ■ 

IF<NNC.LE.10)  KJaNNC 
no  ? JaltNNC-. 

VERTrS(J)aIFLO(l  »J) 

WRITE (4.560)  IFLO(1.21) . IN, IFLD ( I .22) . IFLD ( 1 .23) • 

*( (nP.VERTCS(K). COMMA. VE(TCS(K.l) tCP) .Ksl.KJ.2) 

IF (NNC.LE.10)  60  TO  201T 

WRITE (6.561)  ( (OP.VERTCS(K) .COMMA. VERTCS(K*1) .CP) *K 
CONTINUE 

IF  (FILESV  .EG.  -2)  WRITE(6.565) 

WRITF(6.570) 

60  TO  75 

format  ( ///////  T53. 

*HIST0 


2 

1 


2017 


530 


>11.NNC.2) 


Ml! 

Ml! 

I 

Si* 

H] 

m] 

Ml 


)GHAM  STATISTICS*// 


* RANGEI.WX.'MEAN*  . 7X.  *STANOARO_|j!EV]ATipN». 


MIS00800 
HISOOSIO 
S00820 
S00830 
S00840 
S00850 
S0OB6O 
S00S70 
S00880 
00890 
00900 
S00910 
S00920 
S00930 
MIS00940 
HIS00950 
MIS00960 
H1S00970 
HI5009BO 
MIS00990 
MISOIOOO 
HISOlOlO 
HIS01020 

18184^° 

S01050 
HIS01060 
H1S01070 
VERTICES (SAMPLE. LIMIS01080 
h!S01090 
HISOllOO 
Hlf 

VERTICES(SAMPLE.LlHli  . _ 
HISO] 


16X. •channel* .9X.*DATA* . 
9X.tN0RMALIZE0*M 


>011 


* .*  RANGE*/  86X.*(MEAN  ♦ AND  - 3 STO  DEV)*/) 

540  FORMAT (18*. 1 2,11 X.F5.1.2X.F5.1.7X.F5.1.12X.F5.1.17X.F6.1.2X.F6.1) 

5)0  F0RMAT(////T53.*DATA  BLOCK(S)  MISTOGRAMMEO*//. 

**  T24,*N0.  of  sample  LINE*/ 

*.T3,*CHANNEL  fieldname  VERTICES  INC  INC 

•NE ) • > 

550  FORMAT (////T53, 'DATA  BLOCK (S)  MISTOGRAMMEO*//. 

* T?4,*N0,  OF  sample  line*/ 

*,T12  . 'FIELDNAME  VERTICES  INC  INC 

#NE) *) 

5?0  FOOMAT(4X,I2.7X.A4.8X.12.7X.I4.2X.14.1X. 

*»  5(Al.l4.Al.l4.Al.?X)/T46.5(Al.l4.Al.f 
540  FORMAT (13X.A4,aX.12.7X,l4,2X.l4, IX. 

•5(A1,14.A1.I4.A1,2X) ) 

54T  FOOMAT (T46.S(A1 . 14,A1.14,A1 .2X) ) 

545  F0PMAT(T2.*0NLY  ThE  HRST  50  FIELD  DESCRIPTIONS  _ _ . ^ 

* BUT  all  the  fields  WERE  INCLUDED  IN  THE  TOTAL  MISTOGRAMMEO  STATS*HlS01200 

*)  HIS01210 

570  format (//////  T60.  'TOTAL*/  T53.  HIS01220 

**  'HISTOGRaN  STATISTICS*//  14X . 'CHANNEL  * .9X . 'DAT A * . H1S01230 

**  * RaNGF*.9X. 'MEAN*.  7X. 'STANDARD  DEVIATION*.  9X. *NOHMALIZED*HIS01240 


4.A1.I4.A1.2X)) 


. were  printed. 

MISTOGRAMMEO  ' 


. - 10 

>oll20 
.301130 
HIS01140 
MIS01150 
MIS01160 
HIS01170 
MISOIIBO 
HIS01190 


END 


,*  RANGE*/  05X,*(MEAN  ♦ AND  - 3 STD  DEV)*/) 


HIS01250 

H1S01260 


P/^Ed.tdlA/C  A/C-n-  -p'?/S//cn^bE.K. 


<//^ 


FILFJ  U«18N 


SUflROUTiNE  l4A.lRK(IFLn.NCHFLO.NCVTED) 
n^VlO  LFF  smith  9 SEPTEMBER  1977. 

THIS  SURROUTINF  accepts  an  array  of  EBCDIC  CHARACTERS  AND  CONVERTS 
EBCOIC  nifilTS  TO  A HINARY  INTEGER. 

CALLING  SEQUENCE : 

CALL  lAAlftN«  FIELH,  LENGTH.  OUTPUT  ) 

"WHERE  FIELD  IS  THE  FIRST  WORD  OF  AN  ARRAY  OF  EBCDIC  CHARACTERS 

TO  RE  converted  TO  BINARY.  CHARACTERS  STORED  ONE  PER 
WORD.  LEFT  JUSTIFIED.  AS  BY  AN  A1  FORMAT. 

LENGTH  IS  the  NOmbEH  OF  CHARACTERS  IN  THE  FIELD* 

AND  OUTPUT  IS 'The  one  HORO  RESULT. 

INTEGER  ♦ 4 inUH(2).  IFLO(20) 

LOGICAL  * I L(6) 

FOUl  valence  (L(1)  .lOUMd)  ) . ( ILCH.  IDUM  (1 ) ) . ( ICHAR*  IDUH  (2)  ) 

DATA  ICHAR  / 0 / 
data  IRO  / 240  / 
rata  1P9  / ?49  / 
data  IRBL  / 64  / 

DATA  lOPL  / 78  / 

DATA  IRMl  / 96  / 

NCVTED  = 0 
IERFLG  = 0 
MINUS  * 1 


10 


20 

30 


100 


110 

120 

130 

200 


210 

220 

230 

240 


1000 

250 


NCHFLO 


.LT. 

.GT. 


IRO  ) GO  TO  10 
IR9  ) GO  TO  10 


1»MI  ) 


1 


60  TO  30 
60  TO  100 
60  TO  20 


.EO.  IRBL  ) 68  TO  120 


I 


4A00010 

4A00020 

4A00030 

4A00040 

I4A000S0 

4A00060 

4A00070 

4A00080 

4A00090 

4A00100 

4A00110 

4A00120 

4A00130 

4A00140 

4A001SO 

4A00160 

4A00170 

4A00180 

4A00190 

4A00200 

4A00210 

4A00220 

4A00230 

4AQ0240 

4A00250 


DO  30  I = 

TLCH  = IFL 
L(R>  = L(l) 

IF  ( ICHAH 

IF  < ICHAR 

JOIG  = I 
GO  TO  200 
NFXT  =1*1 
IF  ( ICHAR  .FO.  IRBL  ) 

IF  ( ICHAR  ,fQ.  IHPL  ) 

IF  ( ICHAR  .ME. 

MINUS  = - minus 
GO  TO  100 
IFRFLG  = I 
CONTINUE 
IERFLG  = NCHFLO 
GO  TO  P40 

IF  ( N'-<T  .GT.  NCHFLO  ) 60  TO  130 
no  120  I = NEXT.  NCHFLO 
ILCH  = IFLO(  I ) 

L(fl)  = L(l) 

IF  (ICHaR  .LT.  IRO  ) 60  TO  110 
IF  (ICHAR  ,6T.  IRQ  ) GO  TO  110 
JOIG  = I 
GO  TO  200 
IF  ( ICHAR 
TFOFl.G  = I 
CONTINUE 

IERFLG  = NCHFLO  ♦ 

GO  TO  ?<m1 

no  230  I = JOIG,  NCHFLO 
ILCH  = IFLD(  I ) 

LIS)  = L(l) 

IF  ( ICHAR  .LT.  IRO  ) 60  TO  210 
IF  I ICHAR  .(E.  IR9)  GO  TO  220 
IF  (ICHAR  .NE.  IRHL  ) IERFLG  = I 
ICHAR  = IRO 
TVAL  = IChaR  - IRO 
NCVTEO  = NCVTED  * 10  - IVAL 

CONTINUE 

IF  ( HTNUS  .EO.  1 ) NCVTED  = - NCVTEO 
IF  ( lERFU;  .FO.  0 ) GO  TO  250 
NCH  = NCHFLO 

IF  ( NCH  .6T.  oo  ) NCH  = flO 

WRITE  ( 6.  1000  ) IERFLG.  NCHFLO.  (IFLO(K),  K r 1.  , 

FORMAT (t  F8CDIC  TO  BINARY  INTEGER  CONVERSION  ERROR'/*  AT  CHAPACTERIAAOO 700 

1 '.IS, I OF  *.I5.'  character  FIELDt'/lX.BOAl)  I4A00710 

RFTURN  I4A00720 

END  I4A00730 


NCH  ) 


.4A00260 
|4A00270 
I4A00280 
I4A00290 
I4A00300 
I4A00310 
I4A00320 
14A00330 
I4A00340 
14A00350 
I4A00360 
14A00370 
I4A00380 
I4A00390 
I4A00400 
I4A00410 
I4A00420 
I4A00430 
I4A00440 
I4A00450 
I4A00460 
I4A00470 
I4A00460 
14A00490 
I4A00500 
I4A00S10 
I4A00520 
I4A00&30 
I4A00S40 
I4A00550 
I4A00S60 
I4A00570 
I4A00S8O 
I4A00690 
I4A00600 
I4A00610 
I4A00620 
14A00630 
I4A00640 
1 4 A 00650 
I4A00660 
I4A00670 
I4A006R0 
I4A00690 


PILFt  L ARMAN 


C*« 

C* 

s: 

8: 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 


c* 

c* 

c* 

€<• 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c« 

c* 

c* 

c* 

c* 

c* 

€•* 

c* 


c* 

c* 

c* 


SUBROUTINE  I.ABWANJUNlT,FILE»NOCLS.TOTSUB»NOFEATtTOTFLO*TOTvRTf 

♦ , FETVEC»EL0S4V.VERTEX*CLSNMS»N0SUBS»SUBNM*N. 

• STAORSfVAPSIZ. PUNCH, SU8VFC«PHNSTS»SwTCH) 


SUBROUTINE  STATFL  WILL  WRITE  A STATISTICS  FILE  IN  THE  FORMAT 
FXPECTED  BY  THE  LARSYS  PROGRAM.  IT  WILL  ALSO  PUNCH  THE  MODULE 
DECK  IF  REQUESTED. 

ARGUMENTS  AR^  ALL  INPUT. 


IS. TO  BE  WRITTEN. 

LE  IS  TO  BE  WRITTEN. 


UNIT  - FORTRAN  UNIT  NUMpER  WHERE  THE  FILE 
FILE  - file  number  ON  'UNIT*  WHERE  THE  FI 
NOCL5  - NUM0ER  OF  CLASSES. 

TOTSUH  - total  NUMBER  OF  SUBCLASSES  FOR  ALL  CLASSES. 

NOFEAT  - NUMBER  OF  CHANNELS. 

TOTFLD  - TOTAL  NUMBER  OF  TRAINING  FIELDS. 

TOTVPT  - total  number  OF  VERTICES  FOR  ALL  TRAINING  FIELDS. 
FETVEC  - vector  CONTAINING  THE  CHANNEL  NUMBERS  FOR  WHICH 

the  statistics  were  COMPUTED.  <0IMENS10NED  - NOFEAT) 
FLOSaV  - ARRAY  UIMENSIONEO  - 4 BY  TOTFLD  AND  CONTAINING  THE 
FOLLOWING  information  FOR  EACH  TRAINING  FIELD. 

FLOSAV (1,1)  - NAME  OF  FIELD  I. 

FLOSAV (2,1)  - CLASS  NO.  THAT  FIELD  I BELONGS  TO, 
FLOSAV (3.1)  - SUBCLASS  NO.  THAT  FIELD  I BELONGS  TO. 

ZERO  IF  THE  FIELD  IS  NOT  ASSOCIATED 
WITH  A SUBCLASS. 

FLOSAV (4.1)  - NO.  OF  VERTICES  FOR  THIS  FIELD, 
INCLUDING  THE  CLOSURE  POINT. 

ARRAY  CON'^AINING  VERTICES  FROM  ALL  TRAINING  FIELDS. 
DIHFNSIONEO  - 2*T0TURT,  THE  VERTICES  SHOULD  BE  STORED 
sample  no.  first  Then  line  numher  for  each  vertex. 
CLOSURF  POINTS  MUST  BE  INCLUDED  FOR  EACH  VERTEX, 

(I.»^.  THE  FIRST  VERTEX  IS  REPEATED  AS  THE  LAST  VERTEX) 
ARRAY  containing  ALPHANUMERIC  CLASS  NAMES. 

ARRAY  containing  THE  NO,  OF  SUBCLASSES  IN  EACH  CLASS, 
ARRAY  containing  alpmanuheric  subclass  names. 

ARRAY  containing  THE-NO.  of  pixels  in  each  SUBCLASS, 

IF  PUNCH=1  THE  MODULE  DECK  WILL  BE  PUNCHED. 
called  by  ISOCLS 
CALLED  BY  label 
Called  by  stat 
CALLED  BY  TRSTAT 


VERTF*  - 


CLSNms 

NOSUBS 

SUBNM 

N 

PUNCH 
5WTCH  r 1 
SWTCH  = 2 
SwTCh  = 3 
SWTCH  = 4 


IMPLICIT  INTEGFR(A-Z) 

dimension  FETVFC(NOFEaT) ,FL0SAV(4, TOTFLD) .VERTEX (TOTVRT ) 
DIMFNSTON  CLSNHS(NOCLS) ,NOSUHS(NOCLS) .SUBNM (TOTSU0) .N(TOTSUB) 
DIMENSION  SUBVEC(l) 

DATA  PCHUNT  /?/ 

REAL  C0VAR(465) ,MEANS(30) 


POSITION  ‘UNIT*  TO  CORRECT  FILE  NO. 

savtap=umt 

REWIND  SAVTAP 
NF  = FTLE 

call  FSBSFL(SAVTAP.NF,ISTaT1) 

IF(ISTATl.e0.n)GO  to  1 

write (G.P?0)FTLE 

220  FOPMAT (/TB, IPRROR  IN  POSITIONING  516.  EXTENSION  TAPE  TO  FILE*, 13/ 

• TS. 'OUTPUT  FILE  NOT  whITTEN') 

1 rONTlNUF 

IB  = 1 

data  PChUNT/7/ 

IFIPUNCH.NE.DGO  TO  6 
WPITF (PCHUNT.llO) 

write  (PChUnT, IPfDNOCLS, T0TSUB,N0EF at. TOTFLD. TOTVRT 
WpTTF (PCHUNT. 130) (FETVEC(I) ,1=1, NOFEAT) 

F rONTINUF 

IF  (ISTATl  .NF.  0)  GO  TO  11 

write (SAVTaP )NOCLS.TOTSU«,NuFE AT, TOTFLO, TOTVRT, 

• (FfcTVEC ( J) , J=1 .NOFEAT) 

11  rONTiUUE 

no  ? 1=1. TOTFLD 
NV  = FLDSAV(4,I) 


LA600010 
LAB00020 
LAB00030 
•LAB00040 
LAB00050 
LAB00060 
LAB00070 
LABOOOSO 
LAB00090 
LABOOlOO 
LABOOllO 
LAB00I20 
LAB00|30 
LAB00140 
LABOOISO 
LAB00160 
LAB00170 
LABOOiaO 
LAB00190 
I AR00200 
LAB00210 
LAB00220 
LAB00230 
LA600240 
LAB002S0 
LAB00260 
LAB00270 
LAB00280 
LA800290 
LAB00300 
LAB00310 
LAB00320 
LAB00330 
LAB00340 
LAB00350 
LA600360 
LAS00370 
LAB00360 
LAB00390 
LAU00400 
LAB00410 
LAB00420 
LAB00430 
LAB00440 
LAB00450 
LAB00460 
►LA800470 
LAB004R0 
LAB00490 
LAB00500 
LArtOOSlO 
LAB00520 
LAB00530 
LA800540 
LAB00S50 
LAB00S60 
LAB00570 
LAB00580 
LAB00590 
LAB00600 
LAROCMO 
LAB00620 
LAB00630 
LABO0G40 
LAB006SO 
LAB006H0 
LAB00670 
LAH006HO 
LArfOOGRO 
LAB00700 
LAB007) 0 
LAB00720 
LAR00730 
LAB00740 
LAB007S0 
LAH00760 
LABC(i770 
LAB007B0 
LAB00790 


y/4 


r»r?n  o r>r>r» 


filf:  labman 


IF«IB  *nv*2  -1 
IF (P«JNrM.t%|. if 00  TO  7 
WRlTFCPCHUfittiasJ  (FLDSAV<J.I),J»1,A» 
WR!Tt(PCHUNT»l40J  ( VERTEX (J» IE» 


iST4Tl.NE.0>©0  TO  3 
TFtSAVTAP)  <FL0SAV(J,1».J=1j4» 
TE(«;aVTAP»  (VERTEX(J).J»I8»IE) 


1« 


225 


50 


60 


BO 


IF  I 
WRT 

WRltE(5AVtAP» 

--  TF*1 

riNUE 

IF{PUNCH.NE.1>60  Td  A 
WRITF(BCHUMT,'1*5)  (CLSNHS(I)  f I«1«n0CLS) 
wRnFtPCMim.isOJ  (N0SUBS(I)*I«1.N0CLS»  • 

KOf TE{PCHUNT»155»  <SUBNM(l) ,I»l,TOTSUa> 

CONTINUE 

IF  (15TAT1  ,NE.  0>  GO  TO  18 

WR I TE ( S A V Tap ) ( CLSNMS (I) » I r 1 , NOCLS ) « (NOSUBS ( I » . 1 = 1 , NOCLS) * 
» (SUbNH(I) *1=1,T0TSUB) 

CONTINUE 
TIT  s 0 
WRTTF(6,225» 

FOOMaT(lHl)  » 

NUMSUR  a 0 

TOTSTA  a 0 

DO  20  ICLAS=l.NOCLS 

TOTSTA  a NUMSUR  * TOTSTA 

NUMSUBaNOSURS ( ICLASJ 

no  20  Jal.NUMSUB 

III»III*1 

STaTS  .'PE  CORING  FROH  ISOCLS 

IF  ( SWTCH  .ME.  1)  60  TO  SO 

MFAN1  = STaUPS  ♦ (VAHSI2»N0FEAT)*T0TSTA 

*»EAN2  a MEANl  ♦ (J-l)*NOFEAT 

COVARl  a MtANl  ♦ NUMSUB*NOF£AT  ♦ VARSIZ*(J-1) 

KKalll 
no  TO  «0 

STAT  ABE  CORING  LABEL 

IF  ( SWTCH  .NE.  2 ) GO  TO  60 

KK  = SUBVECnil) 

mEANI  = STAOPS  ♦ VARSIZ<»  TOTSUB 

MEAN2  a MEAN!  ♦ NOFEAT* (KK-1 ) 

COVARl  a STADRS  ♦ VARSIZ*(KK-1) 

GO  TO  PO 

STATS  ARE  CORING  FROM  5TAT 
CONTINUE 

GO  TO  pn  ■ 

STATS  APE  COMING  TRSTAT 
CONTINUE 


READ  MEANS  AND  COVARIANCES  INTO  CORE  FROM  DRUM 

CALL  RBEaD(C0VAR1,C0VA!  .VARSIZ»ISTAT) 

30  IF  (ISTaT  .EO.  1)  GO  TO  30 

CALL  RRE AD (ME AN2, me ANS ♦ NOFEAT. ISTAT 1) 

40  IE  (ISTATl  .ECJ.  1)  GO  TO  40 

IE(PUNCH.NE.l)GO  TO  R 
MRTTE (BCHUNT. 170)N(KK) 

WRITE (OrHUMT, 90)  (MEANS(K) .Kal.NOEEAT) 

WRITE (PCHUNT, 100) (COVAR (K) .Kal.VARSIZ) 
o CONTTNUF 

IF  (ISTaT)  .NE.  0)  GO  TO  20 

WRITE (SAVTaB)N(KK) t ( COVAR (K) .Kal.VARSIZ). (MEANS (K) »Kal .NOFFAT) 
IF(PRNSTS.NE.l)  GOTO  20 

PRINTS  The  STaTS  ON  THE  LINE  PRINTER 

DATA  RC0TW0/*2'/  . 

WRITE (6. 6S) 

EORMAT(/) 

. WRITF(6.3lO)CLSNMSaCLAS)  .SURNM(IH) 

310  EOOMAT{//«  class  ; '.A6/'  SUBCLASS?  •♦A6) 
no  340  LOCa), nofeat. 12 
ST0P=L0C»1 1 

TE (STOP.GT. NOFFAT )ST0PaN0FE AT 
340  wPTTF(f.3S0) (MFANE(I) .laLOC.STOP) 

3SO  FO°MAT(to  MEAN) • .3X.12F9.2) 

WRITE (6.360) 

360  EOPMAT(//«  COVARIANCE  MATRIX)*) 


LAB00800 
LAHOOBiO 
LAB0QB2O 
LAB00830 
LABOOBAO 
LAR00850 
LAB00860 
LAB00870 
LAB00880 
LAB00890 
LAB00900 
LAHO091O 
LAB00920 
LAH00930 
LA600940 
LAB00950 
LA600960 
LAB00970 
LAM00980 
LAB0099Q 
LABOIOOO 
LABOlOlO 
LAB01020 
LAB01030 
LAB01040 
LAB01050 
LAR01060 
LAfcOlOTO 
LAROlOflO 
LAB01C90 
LABOUOO 
LABOlllO 
LAB01120 
LAB01130 
LAB01140 
LAHOliSO 
LA901160 
LAB01170 
LABOl 1«0 
LAB01190 
LAB01200 
LAB01210 
LAH01220 
LAB01230 
LAB01240 
LAB012S0 
LAH01260 
LAB01270 
LAB012B0 
LA801290 
LAB01300 
LAR01310 
LAB01320 
LAH01330 
LAB01340 
LAR013S0 
LABOl 360 
LA801370 
LAB013H0 
LAB01390 
LAB01400 
LAH0141 0 
LAB01420 
LAB01430 
LAB01440 
LAH01450 
LABOl 460 
LAH01470 
LAB014BO 
LASO1490 
LABOISOO 
LABOISIO 
LAH01S20 
LAB01b30 
LAHOlbEO 
LAHOlbbO 
LAHOlbGO 
LAh01b70 
LAH015P0 


FILE:  LABHAN 


CALL  Wb THTX ( COV A« ( 1 > , NOFEAT » BCOTWO ) 

?n  roNTiNUf 

•’  “ ” >* 

19  CONTINUE 

WB  T TE  < A , 1 B 0 ) NOCLS  « TOTSUB 
NRTTE(f«190) 

KbO 

1*1 

?1  NSURSxNOSUHS < I > 

WPTTF(A.gOS) 

Wg I TF ( A , 2 0 0 ) I ♦ CLSNMS ( I ) t NSUaS 
WRITE (6«205» 
no  25  J=1»NSUBS 

KxK^l 

WRTTF (A,210)K*SUBNM(K) 

?5  CONTINUE 

Isl*l  - 

IF(I.LF.N0CLS)60  TO  21 

return 

90  FORMATMMEAN  •»E/F15.S» 

100  FORmaT('COVOR*,5E15.9) 

110  format < tWODuLE  DECK  FROM  HLABEL*) 

1?O^FOOMAT(»NOCLS  'tlA,*  NOSUB'»I*»*  N0FEAT»»I3»»  NOFLO»«I4.* 

l?0  FORMAT(*VECTR*.5X»30I2) 

135  FOOMAT(A6»4X,3<I2«{»X)) 

140  format (• VERTICES  '»l4l5) 

145  FORMAT!  CCLSDESC  •»9(2X»A6))> 

ISO  POOMAT ( ( ‘N05URS  • ,24 ( 1 X» I?) 1 1 
ISS  format  (( 'SURDESC  • , 1 f)  ( Ab»  IX)  ) ) 
lAO  FORMaT(‘FREO  »,12FA.2> 

170  F0RMAT(*N0RTS',7X,Ifl) 

IBO  F0RMAT(///»  THF  statistics  file  for*, 14, • CLASSES  ANO*»IA* 
* • SUBCLASSES  HAS  BEEN  WRITTEN*/) 

105  FOPMATUriw,  *THE  STATS  WERE  WHITTEN  ON  FILE  *»I3) 


TOTVRT 


LABOIOIO 

*,LAB01B20 

LAB01S30 

LABOIBaO 

LAB01B50 

LAH01B60 

LAB01B70 

LAB01680 

LAB01B90 

LAB01900 

LAB01910 

LAB01920 

LAB0I93O 

LAB01940 


IQO  format ('THP  STATS  FOR  A PARTICULAR  CLASS  OR  SUBCLASS  SHOULD  BE  RELAB01950 
•FERRED  TO  IN  later  RUNS  BY  •/•  ThE  FOLLOWING  NAMES  AND  NUMBERS  (W  LAB01960 
•HICHFVFR  APPLICABLE ) »/)  - LAB0I970 

FODMATjSX, 'CLASS', 13, 2X,A6,5X, 'SUBCLASSES  (TOTAL** » 13, ')* ) LAB01980 

205  FORMAT!/)  LAB01990 

210  F0RMAT!25X,I3,2X,A6)  LAB02000 

end  LAB02010 


P,M)R 


CUALiry 


¥^r 


w 


FlLEi  LAPEAO 


FUNCTION  L4PFAn(FLONAM.VERTCS.FL01NF»NC) 

IMPLICIT  INTE(jCH(A-Z) 

OIMENSiON  CftRD(62>,  • FLOINF <6) . VERTCS (2. Il » tVER(?» 10> 
nfMENSION  ACAPO(20) 

DATA  RLANK/*  • / »COMHA/ • . «/»OP/« ( •/ »CP/« ) •/ t 

■ .ENORCO/**ENO*/ 

" '.S/*SU8C»/ 


* AST/**»/.ENOR( 
OATA  C/*CL4S«/i 
DATA  n/*OEST'/ 


.NE.ENOBCO)  60  TO  2^ 


OATA  T/»TtPE*/ 
no  Sn  1*1,2 
no  50 

^0  VEP(I.J)»0  •. 

C SET  UP  REREAD  BUFFER 
PRUNIT*:?0 

CALL  RFHEAO(RRUN1T,80) 

C NOW  PUT  THE  CARO  INTO  THE  BUFFER 
1 PEAO(21,100HACAfiO«I)  ,1*1,20) 

100  FOPMaT(20AA) 

HRTTF(RPUNIT.IOO) { ACARO ( 1 ) , 1*1 ,20) 
rewind  RRUNIT 
C read  in  FIRST  CARD 

REAn(RRONIT,20)  FLONAM 

20  FORMAT (A*) 
rewind  RRUNIT 

IF  (FLONAM  ,NE.  T)  60  TO  55 
LAPEAD  « -4 
RETURN 
55  CONTINUE 

TF(FLONaM,nE.O)GO  to  19 
LAPEA0=-3 
RETURN 
19  CONTINUE 

IF (FLONAM  .NE.C)  60  TO  2A 
LAREaDs-1 
RETURN 

IF (FLONAM  .NE.S)  60  TO  21 
LAREAOs-2 
RETURN 

21  IF(FLONaM 
LAOEADsO 
RETURN 

C RFPFAD  FIRST  CARO 

?2  PE»0(RRUNIT,?3)  CARD 
FORMAT(10*,62A1) 

REWIND  RRUNIT 
COL  = 0 
TI  = 0 
NC  = 0 

C FIND  ( 

11  JsNXTCHR (CARO, COL) 

IF(J.FO.Pt.ANK)  GO  TO  1 

if(j,fo,ast)  go  TO  10 
IF(J.NF.OP)  GO  TO  3 
9 1 = 0 
K*0 
t'KsO 
NUM=0 

4 C0L=C0L*1 

IF(COL.GT.G?)  GO  TO  35 

lF(CARn(COL) .ED. BLANK)  GO  TO  4 

IF  ( ( I .FCJ.O)  .AND.  (CAHO(COL)  .EO.COMMA)  ) GO  TO  3 

IF)  (l.Ffj.l)  .AND.  (CARO(COL)  .ED.CONMA)  ) GO  TO  7 

IF  ( (KK.EO.O) . AND. (CARO(COL) .EO.CP) ) GO  TO  3 

IF  ( (KK.FO.  1 ) . AND.  (CAWD(COL)  .ECJ.CP)  ) GO  TO  8 

CALL  l4AlHt)(CA«D(C0L)  ,1,NW) 

NUH=1  n*NUM*N.< 

IF( (NW.LT,0) .OR, (NW.GT.9) ) GO  TO  3 
1 = 1 

IF(K.EO.l)  KK=1 
GO  TO  4 

^ 7 IFdl.FO.)')  GO  TO  30 

C VFPTFX  sample  number 
NC=NC*1 
VFR(1,NC)=NUM 

K = l 

NIJM  = o 
GO  TO  4 

P IF(II.FO.O)  GO  TO  31 
C VFRTFX  LINE  NUMmeh 


LAROOOIO 

laroooIo 

LAR00030 
LAR00040 
LAROOOSO 
LAROOOGO 
LAR00070 
LAR00080 
LAR00090 
LAROOinO 
LAROOllO 
LAROOifO 
LAR00130 
LAR00140 
LAR00150 
LAR00160 
LAR00170 
LAR00180 
LAR00190 
LAR00200 
LAR00210 
LAR00220 
LAR00230 
LAR00240 
LAH00250 
LAHOnZGO 
LAR00270 
LAR002R0 
LAR00290 
LAR00300 
LAR00310 
LAR00320 
LAR00330 
LAR00340 
LAP00350 
LAW00360 
LAR00370 
LAP00380 
LAP00390 
LAW00400 
LAR00410 
LAR00420 
LAR00430 
LAP00440 
LAH00450 
LAP00460 
LAR00470 
LAR00400 
LAP004R0 
LAP00500 
LAP00510 
LAR00520 
LAK00530 
L4R00640 
LAW00550 
LAPO0S60 
LAP00S70 
LAROOSflO 
LAH005RO 
LAR00600 
LAP00610 
LAR00620 
LAP00630 
LAH00G40 
LAr^OOnSO 
LAH00660 
LAP00670 
LAkOOGBO 
LApnobRO 
LAW00700 
LAWfl0710 
LAP00720 
L AP00730 
LAP0n740 
LAP007S0 
LAH007hO 
LAPf)0770 
LAR007RO 
LAHO07R0 


FlLEl  LAPEAO 


-oni^vfr 
OF  F.' 


PAGE  IS 
Oil  quality 


13 

s 

1? 


V£P(?.NC)*N(N 

CHFCK  FOP  COHMA  op  asterisk 
A J«*^XTCHR(CAPO*COL) 

IF (J. CO. BLANK)  00  TO  ? 
fF(J.CO.AST)  00  TO  10 
IF (J.NF. COMMA)  GO  TO  3 
60  TO  11 

WPTTC(A.13)  CAPO 

format (•  ERROR  IN  FIELD  CARD  TERMINATING  RUN»/10X,62A1) 
CALL  C»«CRR 
WR!TF(6.1S)  CARO 
FORMAT(iOX,6?Al/* 

CALL  CMCRR 

DF7ERMTNF  RECTANGULAR  FIELD 
2 IF< (NC.LT.l).OR.(NC.CT.lO) ) 

NTl»n 
NT'^sO 

NTRalOOOOOO 
NT4=lnOOOOO 
DO  14  Nsl.NC 

TF((VER(!«N).EQ.O).OR.(VER<2*N).EO.O))  go  to  s 
IFCVERU.N)  .GT.NTI)  NT1*VFP(1.N) 

!F(VFR(2.N) .LT.NT4)  “ 

TF(VFR<2,N) .6T.NT3) 

TF(Vfl?(l.N)  .6E.NT2) 

NT?=VER(1.N) 


INCORRECT  FIELD  CARD* TERMINATING  RUN<) 

COORDINATES 
GO  TO  3 


NT4=VFR( 
NT3=VER( 
60  TO  14 


r*N) 

!*N) 


CNTaN 
14  CONTINUE 

FLf'INF  (1)=NT4 
FLniMF(?)sNT3 
FLOINF (4) sNT? 

FLDINF(S)=NT1 

C SFT  UP  VERTICES  IN  CLOCKWISE  ORDER  WITH  SMALLEST  SAMPLE  FIRST 
DO  3?  1=1. NC 
IF(CNT.GT.NC)  CNT=1 
VFBTCS ( 1 . I) =VFR{ 1 .CNT) 

VFOTCS(2.I)=VER(?»CnT) 

32  CNT=CNT*1 

VEOTCS ( 1 .NC* 1 ) aVERTCS ( I . I ) 

VE0TCS(2.I'IC*1)*VEHTCS(2.1) 

35  I AREA0=1 
NC=NC*l 
RETURN 

30  FLD1NF(6>=NUM 
Ksl 

NLlMsO 

no  TO  4 

31  FLniNF (3) =NUM 

11=1  ... 

60  TO  K 

r read  CONTINUATION  CARO 
10  READ(21,23)  CARD 
COL  = 0 
no  TO  11 
END 


LAROOSOO 
LAROOaiO 
LARQ0820 
LAR00830 
LAR00840 
LAR008SO 
LAR00860 
LAR008TO 
LAR008A0 
LAR00890 
LAROOSOO 
LAR00910 
LAR00920 
LAR00930 
LAR00940 
LAR00950 
LAR00960 
LAR00970 
LAR00980 
LAR00990 
LAROIOOO 
LAROlOlO 
LAR01020 
LAR01030 
LAR01040 
LAR01050 
LAP01060 
LAROlOTO 
LAROlOeO 
LAR01090 
LAROnOO 
LAROlllO 
LAROl 120 
LAR01130 
LAP01140 
LAROl 150 
LAR01160 
LAROl 170 
LAROlieO 
LAR01190 
LAR01200 
LAR01210 
LAP01220 
LAR01230 
LAP01240 
LAR01250 
LAR01260 
LAR01270 
LAR01280 
LAR01290 
LAR01300 
LAR01310 
LAR01320 
LAP01330 
LAR01340 


PILE  LiNEROi 


r» 
r* 
c* 
c« 

c 

C«STAR 


SURROUTINE 
IMPLICIT 


, LrNP50</H)ATA/tENOTAP) 
iNTfGER  (A-Z) 


CPEND 


ENTRY  FOR  READING  AND  UNPACKING  ONE  SCAN  LINE  OF  DATA 

LOGICAL*!  ISCAN(A) *BYTE ( A) * lOATA ( 1 ) * IbUF ( I3b00) « IZERO (A) 
include  CMHK17 

COMMON  /HUFF/!ByFF(3375) 

COMMON  /TAPFRD/  YUNlTtiFRST«FSCAN.SAMEND.SAMlNCtREAOY.NS( 

* LINC»in<200)  *DSL.LHUF(30)  tJRECOO)  »IHYTE(30)  ♦N«OFS»FILI 

• tLINlNC*NSAMP,NOCHAN»FORMT 


EOUlVALH'iCF 

EOUIVALFNCF 

EQUIVALENCE 


<SCAN.ISCAN(1|)  HIZEROU)  tZERO) 


( IMUFF* IHUF 
(10(1)  ,NMP!)S 
(U)(.))  ,NPMC 
(iO(S) .NC 
(10(7) .NHirs 
( IO(<V)  ,NDSPK) 


C 

c 


ZERO  OUT 


(10(11) tSVO) . (10(16) tPRSZ) 
lOATA 


) . (10(2) .NCPR  )« 
) « (10(A) fANCLNG) * 
)*(|D(6)«NS  )t 
) • (10(8) *DOI)  • 

« (10(10) fNCAR  ) t 


C* 


SCAN  * 0 

totpix=nsamp*nochan*a 
7ERO*0 

00  180  J=1»T0TPIX 
IftO  10ATA(J)aIZFR0(A) 

IF  (READY)  10(1,190.200 
190  WRITE  (6,A10) 

► 

200  lAOR  = A 

MAXRFC  = PRSZ 
fiUF  = I 
REC  s 0 

IF(F0RMT.FO.A)G0  TO  2000 
iF(N0SPR.EO.l)G0  TO  195 
IF(FSCAN.£O.NSCAN)GO  to  195 
IF( (FSCaN*N0SPH-1) .LE.NSCAN)G0  to  196 
195  CALL  HUFILL(‘VFC.IUNIT,«AXREC,IBUF,NRP0S,ENDTAP,IERR) 
IF(FORMT.F0.3)GO  to  1000 


IF 

IF 

IF 

IF 


FOi^mT 

FORPT 

FORMT 

FORMT 


.EO. 

.FO. 

.FO. 

.EO. 


1) 
1 ) 
2) 
2) 


ISCAN(3) 

ISCAM(A) 

ISCANO) 

ISCAN(A) 


= IHUF(71) 
» IBUF(72) 
= ItSUF(l) 

= IBUF(2) 


L 

L 

L 

L 

L 

L 

;an«  h 

[NOtLlNENO^ 


L 

L 

L 

L 

L 

L 

L 


L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 


IF  ( SCAN  .EO.  FSCAN)  GO  TO  196 


CALL  SEAkCH(A?5O.A235,ENOTAP,I0UF,NRPDS,NOSPR) 

MAXREC=PRSZ 

RUF  = 1 

REC  = 0 

CALL  5UF ILL (REC, lUMlT .MAXREC, leuF.NRPOS.ENOTAP, lERR) 
196  CONTINUF 

ADO  = (NSCAN-FSCAN) *DSL 
DO  230  IFT=1, NOCHAN 
201  IF(LMUF  ( IFT)  .EO.HiJFHiO  TO  205 

CALL  HUF ILL (REC. lUMi I .MAXREC, IBUF.NRPOS.ENOTAP, lERR) 
BUF=HUF*1 
GO  TO  20 1 
205  CONTINUF 

J=J»EC ( IFT) 

JJ»( J-1 ) *MAXREC 

r* 

f*  CHECK  STATUS  OF  THIS  RECORD  BEFORE  UNPACKING 

r* 

IF  (ENDTAP  .ED.  -1)  GO  TO  250 

C* 

C*  UNPACK  DATA  FOP  THIS  FEATURE 

I>  = ADO  ♦ IHYTF ( IFT) *JJ 
DG  ??5  n = l,N<AwP 

THAT  A ( I Anp»4« ( I I-n ) = IBUF ( IP*SAMINC* ( I I-l)  ) 

22 B CD'iriNUK 

lADw  ■-  I ADR  ♦ NS  AMP*/, 


L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 

L 


L 

L 

L 

1. 


NOOOSO 
N00060 
N00070 
Noooao 
NOOO90 
nooT 
NOO 
NOO 
NOOl 
NOOUO 
NUOlSO 
NOO  ■ 
NOO 
NOO 
NOO^  - 
NOOSOO 
N00210 
N00220 
N00230 
N00260 
N00250 
N00260 
N00270 
N00280 
N00290 
N00300 
N00310 
N00320 
IN00330 
N00340 
N00350 
N00360 
N00370 
N00380 
N00390 
N00400 
N00410 
IN00420 
;N00430 
IN00440 
IN00450 
IN00460 
IN004V0 
1N00480 
IN00490 
IN00500 
IN00510 
IN00520 
IN00530 
|n00540 
IN005S0 
IN00560 
IN00570 
IN005H0 
IN00590 
IN00600 
IN006I0 
IN00620 
1N00630 
IN00640 
1N00650 
IN00660 
IN00670 
1N006HO 
INO0690 
INOO  700 
1N00710 
I NOO 720 
INlM)  730 
iNOi)  740 
INOO  7S0 
INUO  760 


AGi':  IS 

' Aury 


file  LINERD 


CONTINUE 

fTnishfo  unpacking  one  scan  line  of  data 

IF  ((NSCAN*LININC» .GT.LINENU)  GO  TO  260 

HAKE  SURE  ALL  BUFFERS  FOR  THIS  DATA  SET  HAVE  BEEN  READ 


IF(BUF,^O.NBUFS)GO  TO  235 

CALL  BU^ lLL(MEC.lUNiT.MAXREC,IBUF.NWPDS»ENOTAP»lERR) 
IF  (ENOTAP  ,EO.  -1»  GO  TO  2S0 
BUF=BUF*1 
GO  TO  231 
continue 

NSCAM=NSCAN*LININC 

If  * (NSCAN’‘Ifil.^FS?AN?NOS^^l?^  236 

FSCAN  a FSCAN  ♦ N0SPR*(1  ♦ LINC/NRPOS) 

RETUON 

F5CAN=FSCAN  * NOSPR*(l  ♦ LINC/NRPOS) 
no  237  Ilal.LiNC 
RE  AO ( lUN IT. 420) dummy 
IF  (NSCAN.LT. (FSCan^NDSPR) ) GO  TO  240 
RE  AO (lUN IT, 420) dummy 
FSCANaKSCAN*NDSRR 
CONTINUE 
RETURN 

IF (NSCAN.GT,LINSTR)NSCAN=NSCAN-LININC 
WRITE  (6.320NSCAN 
IF  (FILFNO  .to.  0)  GO  TO  255 

RACK  SPACE  1 FILE  AND  POSITION  AT  FIRST  SCAN  LINE 

RSKIP  a (NSCAN-IFRST)  * NOSPR  ♦ I 
W»ITE(f5.S<S0)hSKlP 
FORMATC  BACKSPACE*  .13) 
no  PS3  Ilal.HSKIP 
BACKSPACE  lUNlT 
GO  TO  25/ 

REWIND  TARE  AND  POSITION  AT  FIRST  SCAN  LINE 
REWIND  lUNlT' 

oFArx  lUN IT, A20) dummy 
FSCan  = ifrst 

PtAOY  a -1 
PK  TURN 

UNPACK  SCAN  LINE  OF  DATA  FUR  LANOSAT  1 OR  2 

SAMSTRajPFCd  ) 

DO  1100  lal. nochan 
1J=-1 

00  1200  IlaSAMSTR.SAMEND.SAMiNC 
1J=I  JO 
JJ=II 
KK  s 0 

IE  C^OD( 1 1,2) .FO.O) JJaJJ-1 
IE  I 1,2)  .EO.OlKKal 

1 Ano=IHVTE ( I ) ♦ ( JJ-1 )*4*KK 
Il)ATA(  I ADk*A*I  J)  =ItiUF  ( lADO) 

Cn-lTINUt-' 

lADOrl  AI)P.NSAMP*A 
CUNT INUE 
C-.0  TO  2 3S 

UNPACK  SCAN  line  for  LANDSAT  III 
J=1 

SAmSTR  = | BllE  ( I ) 

DO  2S0n  1=1 , NOCHAN 
IE(  I-XTE  ( 1 ) .EO.  J)GO  TO  2200 
LlM-lt>YTE(  I)-J 

Ou  ^inri  llai.i.iM 

RE  AO  ( lUNI  T ,a20)  OU'IMy 
CO  a INUF 

CAl  I.  CUE  ILL  (RE  C.  1 1 IN  IT  .MAX  (f  C . 1 UUF  . 1 . LNU  f AR  . lERR) 

Do  2'(<»0  II=1,nSA.im 


L N9®ZI9 

L N007g0 
L N0079Q 
L NOOttOO 
L Nooelo 
L N00820 
L N00830 
L NOOH4Q 

L Nuoaso 

LIN00B60 
L N00870 
L N008B0 
L N00890 

t 

L N00920 
L N00930 
L N00940 
L N00950 

t 

L N009H0 
L N00990 
L NOIOOO 
LINOIOIO 
LIN01020 
LINOIOSO 
LIN01040 
LIN01050 
LIN01060 
LlNOiO70 
LIN01080 
LIN01090 
LINOllOO 
LINOIIIO 
LIN01I20 
LINOI 130 
LINOl 140 
LIN01150 
LINOI 160 
LIN01170 
LINOllHO 
LIN01190 
LIN01200 
LIN01210 
LIN01220 
LIN01230 
LIN01240 
LIN01250 
I IN01260 
LIN01270 
LIN0I280 
LIN01290 
LIN01300 
L1N01310 
LIN01320 
LINO1330 
LIN01340 
LIN013S0 
LIN01360 
LINOl J/0 
LIN013B0 
LINOI 3R0 
LINOI WOO 
LIN01410 
L IN01420 
1. 1 NO  I w 30 
LINO  1440 
I IN014S0 
L IN01460 
LI  NO  14 70 
L 1N014H0 
LINO 

LINOI son 
1. 1 No  I “1 1 0 
L IN01S20 


FILK  LINEM 


nit < I I-l ) » «IHUF ( 1 3*SAMINC*  ( II-l ) ♦SAMSTR> 


I0ATA(1A0»*A 

KSWmR... 


4#NSAM«» 


>00  TO  «35 


?300 


?S00 


^ A*  • V - 4 !■  * f OOHMV 

?h<in  Continue: 
fiO  TO  ?3S 

^^^•FIFLoIl  MUST  UC  called  to  INITIALIZE  HAMAMETERS  FOR 

*?P  FORMAT ( I A4> 

END 


L 

L 

L 

L 

L 

L 

L 

OF  t)AL 

> NEW  L 
L 


FILE!  LISTLC 


FIELDS  - 


CATEGORY  name  AND  DOT 
FI|LD(1»I»  AND  FIELD < 


I|LD(l»n  AND  nELD<4.I) 
STANNT  - INlTALLY  SET  TO  j»  SmITCmED 
" tEN  FmOM  currently  READ  ' 


TYPE  FOR  DOT  I STORED  IN 


1PT_- 


TAKEN  From  CURRENT 


VERTE**i!*m 


orma 


RRENTL 


TO  Indicate  dots  being 

CARO* 

* NUMBER  FOR  ¥ IELD  VERTEX 
OR  EACH  OOT. 


INFORMATIONL 

L 


^S^BRpUTINF  LISTLC (FIELOS*STAMNT****«»*SWCHG*INITfIUNIT*IFILE»IPT* 
*](hMLICIT  integer  (A-Z) 


OGICAL*!  LCAROOOO)  «LCATNM(4) 


c 

c 


logical 
real  oum 
DIMENSION 

dimension 

*CATNMl/» 
INCLUDE 


F1EL0S(4,1)  *VERTEX(1)  *CAR0(75>  «NDOTSOO) 
ACAROISO) 


CM/ . TRUE . / * ENDBCD/ • SEN  * / » 

•/ 

CMBK14 
INCLUDE  COMRKl 


COMMON/ INFORM/NOCLS?,NOSUB?,NOFET 2. VARS72. TOT VT2.N0FLD2* 

* AVA»?.C0VAR2.CLSID2*SU4N02jSUMDSZiFLnSV?.VERTX2 

* EETV02(30)  .SU>VC/»(7S)  *SUrtPTR(  7b)  .CLSvC2(bO)  * 

* KEpeTS(bf))  »NOr,MM.GRPNAM(bO)  »GRPDtX(61)  t 

* GRPCMK(t)l)  .GROUPS  (1?4) 

COMMON  /OOTvEC/TYPE.CATNAMIfeO) .NOCAT.TOTVEC.FLDINF (6) .PRTKEY 


CSEND 


.SIZE 

dimension  IbU 


*L aCIE 
UF(80) 


1010 

1020 

5 


io3 


1000 


EOUlVALEMCE 

-- 

CalL^FcEmFl ( lUNlT . IF ILE  * ISTAT) 
RFAD  (lUNlT.IOlO)  (IBUFd). 


C 

c 

c 


20 


<LCATnM(1) ,CATNM) , (CARO(l) *LCAR0<1) ) 
IF  (iNIT.NE.O)  GO  TO  5 
REWIND  TUNIT 

FcFMFLd  , 

: : : : : i«i.80) 

FORMAT(BOAl) 

WRITE (4.1020)  (IrtUF(l).  1*1.80) 

FORMAT (IHO.BOAI ) 

IMT  a I 

IF(ST«MnT.£0.2)G0  TO  30 
IF(.N0T.SwITCm)G0  TO  20 
CALL  REPEADOO.flO) 

RE  AD  (1  UNIT,  103)  (ACARfJt  I)  .1*1,80) 
format (MOAl ) 

WRITE (00, 103) (ACARD(I) ,1*1,80) 

RFwIfiD  30 

OEA0(30,1000)  10, types, CARO 
HfWlNn  30 

FnwMAT(A3.1x,Il,7SAl) 
lF(TYPP.EO.TYPtS  ) GO  TO  20 
iF(SWCMG,MF.0)GO  TO  40 
TYPE  » TYPES 

PEAO  CARO 

COL  ■ (1 

CATNM 


|F  NEXT  CHAR  yc;  nOT 

Ie(Catnm,gt.o)go  to 


c 

c 


NXTCHP(CARO,COL) 

‘ - 4 CAT 

21 

LIN0EX*a*C0L*1 
LCATNM(2)»lCAR0(LIN0EX) 

C0L*CnL*1 

IF(CATNM.FO.CATNMnGO  TO  23 
NOCATsNOCAT  ♦ 1 
CATNAM(NOrAT) sCATNM 
C«TNm!  a CATNM 
GO  TO  23 
COL*COL  - 1 
NOCAHDrO  . 

CALL  NUmRP(nDOTS,nDCARD, CARD, COL) 
ir(A'OCAwO.EU.O)GO  TO  10 
ICNT  * 0 
STAmnT  » 2 
SWITCH  a .TRUE. 

GO  TO  100 

TEST  FOP  FND  OF  DOTS  TO  RE  PROCESSED  ON  CARD 
[30  IFdCNT.LT.NDCAROjGO  TO  100 
READ  NFXT  CAPO 


NAME,  CORRECT  COL  COUNT  TO  READ  NUM 


21 

23 


SOOOIO 

S00020 


SOO] 

soo] 
suo, 
sooj 
soo< 

S00230 

S002<»0 


Isuoibo 

500270 
IS00280 
}00290 
>00300 
S00310 
S00320 
S00330 
S00340 
S003S0 
S00360 
S00370 
S00380 
S00390 
S00400 
S00410 
S00420 
S00430 
S00440 
S00450 
[S00460 
[S00470 
SU0480 
S0049A 
S0050Q 
IS00510 
[S00520 
tsoosSo 

IS00540 
S00550 
[S00560 
IS00570 
ISOOSAO 
L1S00S90 
LlSOObOO 
LISOOblO 
L1S00620 
LlSOObJO 
LIS00b40 
LlSOObSO 
LISOOF40 
LISllOb/0 
LIS00680 
LlSO0b9O 
LIS00700 
I IS00710 
L1S00720 
L1SU0730 
L IS00740 
L1S007S0 
LIS00760 
LISO0770 
LIS00780 
LIS00790 


onr>  rto-i  r>m  .nn 


files  LISTLC 


35 


|TAWT  ■ 1 

pllioOO?! 

kEWlNft  3f 

irsfYpF.i 

SWITCH 
SWCHC 

nr 


HI. 

wor  _ 

" ■ - 30 

)«1000  ) ir>.TYPES«C*RO 
30 

J.FNnHCOIHETliHN 

,eo;types)Go  to 

. ^ 6 .FALSE. 

;h6  b SWChG  ♦ 1 
|F<|wrHf,.g|^l)00  TO  <»0 

IPT  B 0 

* CHANGFD  J'INE  28  l'»78 
HETUHN  ? 


hr 


100 


ICNT  B ICWT  ♦ 1 
NOFLD?  B N0FL02  ♦ I 

COMPUTE  LINE  INCREMENT 

NN  B wnoTSdCNT) 

NT  BlARS(  NM)  / lOOOOOOOO 
LT  B IahS(NM)  - NI  • 100000000 
IF<L1.0E.IOOOOOOOO)N1  ■ Ml  ♦! 

COMPUTE  SAMPLE  INCREMENT 

RKBl 

IF<NN.LT.O)KKb-1 
LI  » Nf  * KR 

N?  B NN  - LI  • 100000000 
1BS(  N2)/i0000 

(-N3  • IQOOO 
N3  * 1 


N3  » 14 
5I  ■ I4hS(N?) 
1F(S1.GE.1000)n3 

KKsl 

IF(N?.LT.0)KKb-1 
SI  B «KR 

LACI  « N2  - si  • 
LB  B (LACT-D/19 
LH  B (LP*n  • 10 
LS  B ld  - 1 
LS  « IS  /)0 
LS  * 10  • (LACI  - 
L » LR  -LI. 

S B LS  ♦ SI 

STORE  DOT  INFO 

FlELOSn  .MOFL021 

nS(a,MOFLD2) 

NF(H  B L 
NF<?>  B L 
_ INF (3)  B T 
FLOlNF(<.)  B § 
FLDINF(S)  B f 


10000 


(LS*19) > 


CATNM 

2 


Ep)|NF  (*.) 


IPT 

IPT 


PT.nF.O) 

-i 

IPT  * L 


0 TO  35 


VFRTFXIIPT)  B S 
VFPT^  X ( 1PT*1 ) Bi 
r»?)B§ 


VERTEX  nPT< 
vertex ( IPT*3) 
return  1 

40  WRITE (4.2000) 

2000  FORMAT (//BX. 'FEPOP  HAS  occurred  IN  HEADING  LACIE 
•OS  - SUHPnUTiNE  FLOLAC  - EXIT  TAKEN*) 

RETURN  3 
END 


formatted  dot  carl 

L 

L 

L 


S00800 

SOQ810 

00820 

.00830 

Si)0840 

S008S0 

S00860 

S00870 

SOO80O 

SU0890 

S00900 

SO09l0 

S00920 

S00930 

S(j0940 

S00950 

S00960 

S00970 

S00980 

S00990 

^“im 


.200 

290 

1300 

US 


S012S0 
S01260 
S01270 

sof 
sol 

SO 

so 

sol, 
so  1330 
so  1340 
S01350 
I SO  1 360 
1S01370 
SO130O 
S0l390 
soUoo 
S0t410 
,501420 
!sol43o 

S01440 

S01450 

S01460 

$01470 

50!4«0 

S01490 

S01500 

-SOlSlO 

IS01S20 


riLf*  MATveC 


?u«ftnuTiN 
MULTIPLY  P*TM. 
ON 


!, 


« 


m*TVFCC*«H»C*L»M) 

X « PV  VfCTOx  B AND 
A(L«P)«B(M) «C(L) 

. l»L 

no  % "■!*« 

fUMaSUP*A(I «K)*BCK) 
r(i)«suH 
wftupn 

FNO 


STORE  IN  VECTOR  C 


(U' 


\1  V ‘AU'’  1-' 
Mni  quality 


F!LP!  MTMSAT 


I 


5UFP0UTINE  mthoaT  <».«.C*LfM,N,0«00) 

MULTIFLy  MATPI*  A »y  TMf  TRANSPOSE  OF  8 ANP  STONE  IN  00 
A loner  THIANhULAN  MATRIX 

OIMENSTON  A<L*M>.it(N*M)  .ca»N»,o(u.oo<n 

06  Nf>  I«1»L 

00  AO  Cl>I«N 

5UM«0.0 

00  SS  K»1.M 

AS  Sl)M«5U»'*An.J<)«B«J.K) 
r IT jj»»suM 

lEn.Erj.J)  om«SORT(SUM> 

AO  continue 

MN»0 

RK«0 

00  1 II«J,L 

KKsAK*T 
PO  1 LL«1»KK 
MMbNM*) 

OOIm«))«CIII,LL) 

1 CONTINUE 
RETURN 
ENO 


FILF!  MTMLS6 


8 


SURROUTINE  MTMLS6(AtB«C«M.N) 


MULTIPLY  MATRIX  A BY  B AND  STORE  IN 


niMENSION  A(M«N)*H(l)tC(M,N) 

no  50  J*l,M 

UE«0  . . 

no  40  I«l.N 

LB«LE^1 

LE=LE*I 

5UM*0. 

KsO 


no  35  L«L8fLE 

KsK*l 

35  SUMsSUM*A ( J.K)*R<L) 
TF(I.FQ.N)  GO  TO  40 
KS=K4l 
L=LE 

no  35  K=KS,N 
LsL*I*K-XS 

3ft  5UM=5UH*4(J.K)*B«U 
■ 40  C(J.I)sSUM 
50  rO^-TINUE 

RETURN  ' 

END  . . 


C. 


HTMOOOlO 

MTM00020 

B IS  5T0RE0  IN  SYMMETRIC  NOTATMTM00030 

MTM00040 

MTM00050 

MTM00060 

MTM00070 

MTMOOOflO 

mthOOORO 

MTMOOIOO 

MTMOOllO 

MTM00120 

MTM00130 

MTM00140 

MTMOOiSO 

MTMOOlftO 

MTMOOlTO 

HTMOOieO 

MTM00i90 

MTM00200 

MTM00210 

MTM00220 

MTM00230 

MTM00240 

. . MTM00250 


ooooo  n r>  non 


PILF:  NMMSTA 


C 

C 


LOG 
FOl 
K I 


t!\ 


NAMSTA  ASSIGNS  NAMES  TO  CLUSTERS  AND  UPDATES  STAT  INFO 

subroutine  NAMSTA(SUBNAMtCATVEC»SUBN0.N0SUB2,CATNAM»N0CAT) 

IMPLICIT  INTEGER  (A-Z) 

DIMENSION  SilPNAMIGO)  .CATNAM(60) 

DIMENSION  CATVEC(GO) .SUBNO(l) 

!NTFGPR*4  14(3) 

CAL«1  LKl?) 

VALENCE(LlTl).l4(in 
0 

ASSIGN  names' TO  CLUSTERS 

DO  20  l»l»NOCAT 
L = n 

DO  20  Js1.N0SUB2 
IF  (CATVEC(J)  .NE.  I)  GO  TO  20 
K a K ♦ 1 
L a L ♦ I 

USF  FIRST  2 char  of  CATEGORY  NAME  ♦ 2 DIGITS 


14(1)  a CATNAM(l) 

CALL  RNI4A1 (14(2) .2.L) 


LI (3)=L1(5) 
LI  (4)sLl (R) 


SURNAM(K) 
20  CONTINUE 


s 14(1) 


CHFCK  FOR  NULL  CATEGORY 
TaNOCAT 

30  IF  (SURNO(l)  .NE.  0)  GO  TO  60 
IF  (I  .FO.  NOCAT)  60  TO  55 
■ no  SO  J= I, NOCAT 
CATNAM(J)  a CATNAM(J*1) 

GO  SURfJO(J)  = Sll«NO(J*l) 

S5  NOCAT  a NOCAT  - 1 
(SO  TaI-1 

.TFd.GT.O)  GOTO  30 
return 

END 


NAMOOOlO 


NAMOOO: 

NAMooo: 


NAM00040 

NAMOOOSO 

NAM00060 

NAM00070 

NAM00080 

NAH00090 

NAMOOlOO 

NAMOOllO 

NAM00120 

NAM00130 

NAH00140 

NAMD0150 

NAM00160 

NAM00170 

NAMD0160 

NAM00190 

NAM00200 

NAMOOgiO 

NAH00220 

NAM00230 

NAM00240 

NAM00250 

NAM00260 

NAM00270 

NAM00260 

NAM00290 

NAM00300 

NAM00310 

NAM00320 

NAM00330 

NAM00340 

NAM00350 

NAM00360 

NAM00370 

NAM00380 

NAM00390 

NAM00400 

NAM00410 

NAM00420 

NAM00430 

NAM00440 

NAM00450 

NAM00460 

NAM00470 

NAM00480 


FILF:  NUMREH 


Q1 

97 

C 

C lOf. 


function  NURPER(CAROfCOL.NUMVECtNOW) 

IMPLICIT  INTEGER  (A-Z) 

OIMFNSION  CAROf 1) .NUMVEC(l) 

OATA  CROSIZ/F2/.VECSlZ/lnO/tBLANK/*  i/«COMMA/> • 
OATA  ZEH0/»0*/»NINE/»«>*/ 

NEXT  s NOW  ♦ 1 

IF(  NEXT  ,LE.  0 .OR.  NEXT  .6T.  VECSIZ)  NEXT  » 1 
j * 0 
L = COI.*l 

IF(  L .HT.  CROSIZ)  60  TO  92 
VK=VEC?IZ  - 


00  80 
JJ  = J 
NU*^  = 0 
TTPIGsO 
00  ^0 
IF  (CAR 
IF  (CAR 


JsNEXT.VK.l 


^0  COL=L.CROFIZ* 1 
(CAPO(COL) .FO. BLANK) 
(CaRO(COL) .EQ. COMMA) 


60  TO  60 
GO  TO  70 


IF(CARD(Ci>L) .LT.7FRU.OH.CARO(COL).GT.NINE)  60  TO  90 
CALL  UA1hn(CARD(C0L) .l*NwORO) 

NUM  = 10  * NLIM  ♦ NWORD 

ITRIG=1 

CONTINIX^ 

COL  = CROSIZ 
GO  TO  RO 
NUMVFC(J)  = NUM 
L = C0L*1 

IF(  L .GT.  CROSIZ)  60  TO  92 
CONTINUE 
J = VFCSIZ 

IFdTklG.h-Q.DGO  TO  91 
J = J - 1 
GO  TO  Q2 
NlJMVFC(J)  = NL‘ 

NUMPFR  s J 

WRTTF(  6,106)  ( CARD ( K ). K= 1 , 62 )» COL t NUMBER ♦ (NUMVEC (K ). K*1 » J) 
FOPMATC  NUMBER  £NTERFO'/»  '»b2Al*I10/'  • .IG'1813) 

RETURN 

t 

► function  entries  must  return  value  in  ORIGINAL  FUNCTION  NAME 


PAGE  IS 
’ (,'i  Af,iT7 


ysi 


FiLri  numbr 


time. 

NDQTS.t^lTM 


C*  SUMROUTINE  NIJMO«  w|ll  PROCESS  ONE  CAPO  AT 

C«  TT  REARS  AND  STOflES  ALL  NUMBERS  IN  ARRAY  ^ 

C*  NOCARD  AS  AN  INDEX.  BLANKS  ARE  THE  ONLY  RECONIZCO 
C*  OFLIMITERS. 

SURROUTINE  NUMRP (NOOTS*NOCARO.CARO«COL) 

IHPLICTT  INTEOER  <a-2) 

DIMENSION  NOOTSin .CARO(l) 
data  blank/'  '/,CR0SIZ/75/ 

NUM«0 

NC  « COL  ♦ I 

S IF  INC.6T.CC0SI2)60  TO  50 
no  in  T«NC»rROSi2 

IF(CARn(I)  .FO.PLANIOGO  TO  T 
CALL  l4AlHN(CA«0<n .l.NWORD) 

NUM  s NUM*10  * NwORO 
GO  TO  30 

7 TF(NUM.LT,1)G0  to  30 

IF JNUM.GT, 209) WRITE (6.500) NUM 

ndcard»nocamo  ♦ 1 

ND0TS(NDCAR0)*NUM 
NUM  * 0 
30  CONTINUE 
10  CONTINUE 

500  FORMAT (//SX, 'LACIE  DOT  READ  THAT  IS  GREATl 
•OF  - EXECUTION  CONTINUED  WITH  VALUE  Rl 
50  CONTINUE 
RETURN 
END 


;r  than  size 

•AO  OF  *.I4T 


LIMIT 


NUMOOOlO 
NUH00020 
NUM00030 
NUMOOOAO 
NUM00050 
NUM00060 
NUM00070 
NUMOOOSO 
NUMOOpOO 
NUM 00  1 00 
NUMOO  .10 
NUMOO  ,20 
NUM00130 
NUM00I40 
NUMOOiSO 
NUM00I60 
NUH00I70 
NUmOOIRO 
NUM00190 
NUH00200 
NUmOOZIO 
NUM00220 
NUM00230 
NUM0024P 
NUM00250 
NUM00260 
NUM00270 
NUM00280 


r»or>oonoor»or»oo 


FILF:  NXTCH9 


function  NXTCHR»CAR0*C0U 


CALL  J>NXTCHR(CAROtCOL) 

ARCS  CARD  - BCD  BUFFER 

COL  - PTR  TO  POSITION  IN  ‘CARD* 

PURPOSE  LOCATES. THE  NEXT  NON  BLANK  SYMBOL  IN  »CARO» 

RETURNS  J-  - LOCATED  CHARACTER  (BLANK  IF  EOC) 

COL  - PTS  AT  character 

TMPLICIT  INTEGER  (A-Z) 

DIMENSION  CaRD(l) 

DATA  CP0SIZ/62/»BLANK/»  •/  „ . .. 

L B COL*l 

IF  (L.6T.CRDSIZ)  GO  TO  40 

no  30  col»l.crosiz 

NXTCHP  s CaPO(COL) 

IFCNXTCHR.NE. BLANK)  GO  TO  50 
30  CONTINUE 
rOl.=CRO§IZ-l 
40  NXTCHR  a BLANK 
SO  CONTINUE 

C WRITE  (H.104)  (CAPO(K) ,Kal,62) tCOLfNXTCHR 

104  FOOHAT(»  NXTCHR  ENTERED'/*  '*62AltI10/'  'fA4> 

RETURN 

END 


NXTOOOlO 

NXT00020 

NXT00030 

NXT00040 

NXTOOOSO 

NXT00060 

NXT00070 

NXTOOOSO 

NXTOOORO 

NXTOOlOO 

NXTOOllO 

NXT00120 

NXT00130 

NXT00140 

NXT00150 

NXTOOIGC 

NXT00170 

NXT00180 

NXT00190 

NXT00200 

NXT00210 

NXT00220 

NXT00230 

NXT00240 

NXT00250 

NXT002N0 

NXT00270 

NXT002H0 

NXT002Q0 

NXT00300 


page  is 
OP  p;  ’ si;  quauty 


FILI-I  ORDER 


SUBROUTINE  ORDER (WECtN) 
“ INTF.6FRtA-Z) 


SUBBOUT  I 
IMBLICIT 
niRENSlO 
LOGICAL 


IFIN.LE 

MkM-) 


ON  VEC( 

•it^eTu 

SWITCH*. FALSE, 
no  10  I«1»H 
IF«VEChf|LE.V 


(1) 

H 

URN 


TEMR*VFCjn 


VECII«l))GO  TO  10 


10 


- <l^l> 
1 »*TEBP 
TRUE. 


IFCSWITCMIOO 

RETURN 

END 


TO  5 


FILPJ  PRINT 


cse^'o 


r)iMF-N<;ioN 

niMFNSlUN 

mwFN<;inN 

niMFNSTUN 

OIMENSION 


(FINF(4) .SAMSTR) 
(FINF (5) tSAMFNO) 
(FlfMF«6)  fSAMINO 

(COL(l.lll) tNRLK) 


20 


30 


40 

31S 


4«> 


SURROUTTNF  Pk^INT (KKT* IPLACE»MEANS»STOEV.CLOtFLOINF,N) 

IMPLICIT  INTFPERtA-X) 

INCLUOF  COMPh*i,LIST 
INCLUDE  COM>»Kh,LIST 

COMHON/PASS/STOP.LNCAT»NMINfKRNtSTOMAX.DLMIN»$EP»  , 

MAP«SPT«IGt  IR0»  KPTSt  NOPTS*  PUNCHt 
lCHN,CHNTHS.ICMAlN<«.2),NWDStIRe6lN.REGINl»,„,  , 

HFeiN?.FiFGIN3.CLSNAM.N0FL0»IPT»TnTW«D»T0TPTS» 
NCLASS.NOCLS.TOTSUflfTOTFLD.TOTV«T*NOCLtNV«T 
,NXTCLS.N0FFAT»MAXCLS*FETVEC(30) »SYMMTX(62»  ^ 
*VAP517,STATKY,ISOKFY,MAPFMT.MAPKFYtSEQUEN(20»  tPERCEN,SIMERP 
,inpnFPtlM)MT, iNFlLEt lNlTM,PMlNtSUBVEC(62) .NOSUB2tCHNVC (50) 
,NOrHAN.FrtrOMP,NOSfc'3.MtANnOtMFANOUt 
SYMOOtSYMOU. ITPIGO.ITRlGU.nOFLAG. 

nUFLAG.DODUfSTDOTS(60) *NSD0TStSUNCOR(30) «LLNCATf 
DVEPT (2S0.2) «DPECT (60*2) »0VPNT ( 1 1 .2) . lOCNT (2) *N00U(2) 
.MXFETI.'^axPOP 
RFAL  SUHCOR 

C0MM0N/6L0BAL/HEAr)(<S3)  *MAPTAP*DATAPC*SAVTAP* HMFILE*BMKEY*_ 

HISFIL*MISKEY*TPFORM.ERIPTP.ERPXEY*MaPUNT»NOFILF» 
n«UMA0.n«M>*DS.PAGSI2*0ATFIL*STAFIL*A5AV*ASAVFL 
,NHSTUN.rvlHSTFI,SCTRUN*M4PFlL  . ^ 

.OOTUNT.OOTFIL*NCHPAS«TRNSFL*BMTPFL*MlSTFL*PCHUNTt 
CPOUNT.PRTUNTtPANOIO 

IPl.ACE  (NOPTS) 

HFAN«;  (N0FF.AT  ,M4XCLS)# STOEV  (NOFEAT, MAXCLS) 

SYMhLS ( 1 ) ,FL ( 12) 

FLO  INF ( 1 ) 

Cl.n(MAXCLS,l)  *N(MAXCLS)  *NBLK(62>  *FINF(6) 

PEAL  MFflNStSTDEV.CLO 
DIMENSION  COL(1,110) ,OUT(110) 

FQliIVALLNCE  (F  INF  ( 1 ) .LINSTP)  * 

* (FINF  (P)  .1.  INENO)  * 

* (FINF  (3)  *1.  ININC)  * 

FOI  IT  V ALFKCF (sYmmTX. SYMHLS) 

FQHIVALFNCt (COL (1, 1 > ,OUT  ( 1) ) * 

DATA  HLAfvr./'  •/ 

IF (DODU.EO.O)  GO  TO  20 
SAVEP=SYMMf  X (LNCAT-DOnU*OOFLAG) 

SAVFP  = *^YMmT<  (LNCAT-l'OnU*DOOU) 

IF  (OOFLaG.NE.O)  SYHMTx (LMCAT-DOOU  ♦ 1)  = SYMOO 
IF  (DUFLAG.NE.O)  SYMMTX (LNCaT)  s SYMOU 
CONTINUE 
WRITE  (^,HE:fiO) 

IF (KKT.OT.O) WRITE (6,240 )KKT 
IF(KKT.LT.0)WRITF(6,245)CLSNAM 
WRITE  (6. 2S0)LNCAT 
T0TPTS  = TUTVRD/IM0FEAT 
WRITE (6.260) TOTPTS 
WRITE  (6.270) 

DO  30  J=l, LNCAT 
WRITE  (6,2G0) J,SYMBLS(J) ,N(J) 

CONTINUE 
WOTTE  (6,290) 

ISTART  = 1 
TEND  = 12 

LOOPCT  = UOEFAT  / 12 
LOOPCl  = MOO (NOFEAT , 1?) 

IE  (LOOPCl  .GT.  0)  LOOPCT  = LOOPCT  ♦ 1 
IE(LOOPCT  .E(J.  1)  lENO  = NOEEAT 
no  45  M=  1 .I.OOPCT 

WRITE  (6, 3r,0)  (PLANK, FFTVEC(J)  , J=ISTART,  IEND) 
no  40  J=l.l,NC4T 

WRITE (6,3 10). J, (MEAN5(1,J) ,1*1  ST art, IEND) 

CONTINUE 
WRITE (6, 3 IS) 

FDOMAK  ) 

ISTART  = tend 
tend  = ISTAi'T 
TF  (IFND  .GT, 

CONTINUE 
ISTAPT  = 1 
IFND  = 12 
IFILOOPCT  ,EO. 

WRITE  ( 6,32')) 

00  5S  M=i, I.OOPCT 

WRI  TF  (6,  3')0)  (HLANK.FETVEC  ( J)  , J=  I ST  ART  , I END ) 

DO  SO  J= ) .1 UCAT 


1 

TEND  - 1 
NOFEAT)  IEND  = NOFEAT 


1)  lENO  = NOFEAT 


PRIOOOlO 
PRI 00020 
PRI00030 
PRioOOAO 
PRIOOOSO 
PRI00060 
PRI00070 
PRIOOOSO 
PRI00090 
PHIOOIOO 
PRIOOIIO 
PHI00120 
PRI00130 
PRIOOHO 
PP100150 
PPI00160 
PRI00170 
PMI00180 
PRI00190 
PRI00200 
PPI00210 
PRI00220 
PPI00230 
PRI00240 
PR100250 
PPI00260 
PHI  00270 
PPI00280 
PP100290 
PPI00300 
PPI00310 
PRI00320 
PRI00330 
PHI  00340 
PRI003S0 
PRI00360 
PWI00370 
PRI003P0 
PRI00390 
PHI00400 
PHI00410 
PRI00420 
PRI00430 
PRI00440 
PHI00450 
PRI00460 
PRI00470 
PRI 004H0 
PRI00490 
PRI00500 
PRIOOSIO 
PRi0O520 
PRI00530 
PRI00540 
PRI00550 
PRI00560 
PWI00570 
PRIOOSflO 
PRI00590 
PRI00600 
PRI00610 
PRI00620 
PRI00630 
PRI00640 
PRI00650 
PRI00660 
PRI00670 
PRI  006H0 
PHI  00690 
PPI00700 
PHI  00710 
PHI00720 
PHI  00730 
PHI  00740 
PRI 007S0 
PRI 00760 
PR  I 00770 
PRI007E10 
PR100790 


¥3^ 


original  page  is 

OF  POOR  ouauty 


FlLf-t  PRINT 


C* 


C* 


SS 

60 

70 


AO 

OO 


105 

110 


115 

lift 


- I 


END  s NOFEAT 


>L*J) 


WRITE (6, 310) J. (STDEV(1*J) ♦I«ISTARTtlENO) 
CONTINUE 
WPITE«A.31|) 

ISTAliT  » fENO  ♦ 1 
TfNf)  a I5TAQT  ♦ lENO 
IF  (lEK'O  .GT.  NOFEAT) 

CONTINUE 

JaLNCAT 

IF(J.GT.IS) Jal5 
WRITF  (6,3A0) (KfKaLtJ) 
no  TO  IsI.LNCAT 
WRITE  (6.)50) 1, (CLOIIfK) ,K 
IF  (J.FO.LNCAT)  60  TO  80 
LaLMj? 

JaJ»15 

IF U.GF.LNC AT) JaLNCAT 
GO  TO  60 
CONTINUE 

IF  (KKT,E0.-1)  go 

IF(MOft(KKT*  

CONTlMJf 
IRC=IRO 
ICCTaNOPTS 

IF(IRO.EO.O) ICCTaKPTS 
IF  (IRn.EU.O)  GO  TO  110 
A0RE5?=HEGIN? 

CALL  HpkaD(  Af)RES2.  IPLAgE.ICCTtlSTAT) 
IFUGTAT.KQ.DGO  to  105 
a0BES?=a0HE52*ICCT 
IRFCsl 
JPTSsO 
IPC=IPC-1 

CALL  ‘5FTM«6(66»0.66) 


..  --  TO  90 
MAP) .NE.0)RETURN 


IV=S 

no  ?nO  IFLOal.NOFLO 
7EP0  NML6 
DO  115  I = l,l.NCAT 
NHLK(  I)sO 

FLONAM  = FLDINF(IV) 
NV=  FLHINF ( IV*1  ) 
IBaIV*?*NV*2 
DO  116  1=1,6 
FINF(II=FLDINF(IG*I) 


Jan 

IPO  no  no  I=SA<-STP,SAMENDfSAMINC 
J=J*1 

COL <1 ,J) =1/100 

coi.  =Mon<  1 , 100)  / lo 

COl (3, J) =MOD| I, 10) 

IF  (J.FO.llO)  60  TO  UO 
no  CONTINUE 
140  I.PTS=J 

WRTTF  (6,?20) 

WRITE  (6. HEAD) 

TPTS  = Fl  I'lNF  ( IV»NV*?*P) 

WRITE (6,330)FLnNAM,TPTS 
no  150  1=1,3 

IGO  WRITE  (6,?10)  (COLdfJ)  tJ=l*LPTS) 

WRITE  (f',/PO) 

no  nn  I=LINSTR,l.INENO*LININC 
find  field  INTERSECTIONS  FOR  THIS  LINE 
CALL  FOLI'mT  ( eld  INF  ( 1V*2)  ,NV«FL»  I tPTS,NFL) 
no  155  J=l,110 

155  OUT(J)=hLANK 

no  175  IJ=1,NFL,2 

IR=(PL (I Jl -SAMSTR) /SAMINC  ♦! 

IE=(FL(1  JM)-SAHSTR)/SAMINC  ♦ 1 ^ . 

1F(M01'(SA5STW,SARINCI ,NE.MOO(FL( IJ) , SAM  INC )) 18=1 B*1 
IF(Ih.GT.IE)GO  to  175 
no  170  ,J=IR.1E 
JPT5=JBT5*1 

IF  (JPT5.LE.ICfT)  GO  TO  160 
IFdRC.EO.l  ) ICCTsKPTS 
CALL  RPEA()(Ar)RESP,IPLACEtICCT,ISTAT) 
4nPES?=AORES?*lCCT 

156  IF  (ISTaT.E'J.DGO  10  156 
IRC=IPC-1 

JPTS=1 


PRI00800 

PR100810 

PRI00820 

PRI00830 

PRI00840 

PRI008SO 

PRI00860 

PR100870 

PRI008AO 

PRI00890 

PRI00900 

PRI00910 

PRI00920 

PR100930 

PRI00940 

PHI009S0 

PRI00960 

PRI00970 

PRI009A0 

PRI00990 

PRIOIOOO 


PR 

PR 


01010 

01020 


PRI01030 

PRI01040 

PRI01050 


PRIO 
PR  10 
PRIO 


060 

070 

060 


PHlOlOQO 


il 


00 

0 


II 


PRIO 
PRIO 
PRlOl 
PRI01130 
PRIOl 140 
PRI01150 
PRIOl 160 
PRIOl IVO 

pRiomo 
pRioino 
PR’,01200 
PRI01210 
PRI01220 
PRI01230 
PHI01240 
PRI01250 
PR101260 
PRI01270 
PRIO12A0 
PRI01290 
PRI01300 
PRI01310 
PRI01320 
PR101330 
PPI01340 
PRI01350 
PR101360 
PRI01370 
PRI01350 
PRI013R0 
PRI01400 
PRIOHIO 
PR101420 
PRI01430 
PRI01440 
PRIO1450 
PRI 01460 
PRI01470 
PRI014A0 
PRI01490 
PRI01500 
RRI01510 
PRI01520 
PRI01530 
RHiniSAO 
RRI01550 
PR101S60 
PRIOISTO 
PRI015H0 


riL€l  PRINT 


160 


170 

175 

IPO 


190 

200 


?05 


110>  GO  TO  170 
BLS(K» 


210 

po 

?«0 

245 

250 

2*>0 

2T0 

?B0 

290 

loo 

310 

320 

330 


CONTINUE 
K«IPLACR<JPTS) 

NRI.K(K)>NBLK(K)*1 

OUT(J»»SYMi 
CONTINUE 
CONTINUE 

WRITE  (6.230)LINF, (OUT(J) ♦J»1»LPTS> 
CONTINUE 

IV»IV  ♦ NV*2  ♦ 9 
WRITE  (6.370) 

00  190  I«1.LNCAT 

WRITE  (4,3«0)  I.STMRLSm  .NPLKm 

CONTINUE. 

lE(DOnU.EO.O)  GO  TO  205 

SYMMTX (LNC4T-D00U»00ELAG) »SAVEP 

IE  (0UEI.A6.NE.0)  SYMMTX  (LNCAT)  » SAVES 

CONTINUE 

Cftl.L  SETMPG  (66.4.62) 
return 

EOOMAT(yX.nOll) 

FORMAT)/) 


EOHMAT(2X.I5,2X.linAl) 

“ ■ INTERMElHATE  PRINTOUT  FOR  ITERATION* . 15//) 

CLUSTER  summary  FOR  CLASS* ♦ IX. A4//) 


13) 


FORMAT (//•  TNTERM 

FORMAT)//*  FINAL  . 

FORMAT!//*  total  NUMBER  Or  CLUSTERS 
FORMAT!/*  TOTAL  NUMBER  OF  POINTS  ■*.I7) 

FORMAT)//*  CLUSTER  SYMBOL  POINTS  IN  CLUSTER*) 
format (4X. IR.9X.A1 ♦ lOX. 17) 
format (///! 9 X. * MEANS*/) 

F0RMAT(/2X, *CLUSTFR*.5X.I2(A1.*CH(*.I2.*) * 
format (5X. 12, IX,12(F7,2. IX) ) 

FORMAT)///1oX.*  standard  DEVIATIONS*/) 

format (//2X.A4,//*  TOTAL  NUMBER  OF  POINTS  IN  THIS  FIELD*. 17/ 

•) 

340  format )//15X, *niSTANCES  HFTWEEN 
350  F0RMAT(3X.I?,SX.  I'iFa,?) 

370  FORMAT )///X.*POlNTS  PER  CLUSTER 
**  5X.  *SYMMOL  * .5X,  *POINTS*/) 

3A0  FORMAT(6X.1?.10X.A1.7X.I5) 

END 


>1X)) 


clusters *//lX. *CLUSTER* .1518) 
IN  THIS  FIELD*/3X.*CLUSTER*. 


PR 

PH 

PR 

PR 

PR 

PR 

PR 

PR 

PR 

PR 

PR 

PR 

PR 

PR. 

PR  I 

PR 


01590 
0)600 
01610 
01620 
0)630 
01640 
0)650 
0)660 
01670 
0)650 
01690 
01700 
01710 
01720 
01730 
.01740 
PRI01750 
PRI01760 
PRIOl 770 
RR101780 
PRI01790 
PR1O10OO 
PRIOIAIO 
PRl0)e20 
PRI0I830 
PRI01840 
PRI 01850 
PR101860 
PRI01870 
PRI01880 
PRI0)890 
PRI01900 
PRIOIRIO 
PRI01920 
PPI01930 
PR10)940 
PRI0I950 
PP101960 
PRI01970 
PRi01980 
PR101990 
PRI02000 


oonr>r> 


PRTCOV 


SURROUTINE  PRTCOV (COVHT*»AVEMTX.CVl.*VlfCLSMTX» 
WRITE  HEADING  FOR  TRANSFORMED  COVARIANCE  MATRIX 
TMPUCIT  INTEGEPU-Z) 

REAL  COVMTX  (CVNNOSU92)  t AVEHTX  (AVl*NO$UB2) 


INCLUDE  COMRKI.LIST 
tNCLUOF  COMBk*. 


l.L  ST 
>«L  st 
».LIST 


INCLUDE  COvf>he», 

INCLUDF  C0K=^XR.L1ST 

COMMON/ INFO»M/NOCLS2»NOSUP2.NOFFT2»VARS7?fTOTVT?tNOFLD2* 

• 4VAP?.C0VAH?,CLSI02*SUaN0?.SURDS2»FL0SV?.VERTX?» 

• FETVC2(30)  «?URVC2(H»  .SU«PTR(7S>  «CLSVC2(60)  ♦ 

• KFRPTS(An) .NOGRR,6«PNAM(60) *GRPDEX(61) • 

• C-RMCHR  (I«.n  , GROUPS  ( 124 » 

DIMENSION  HEOl  (IS)  .HED;5(1G)  ,D4tE(3)  .C0MENTU5) 

Foul  valence  (hedi n ) .head(4) ) t (Date (1 ) ♦head (2?) > * 

2 (HED2( 1) tHEA0(30) ) f (COMENT(l) .HEA0(48) ) 

COMMON/GLOBAL/HEAn(63) ,MARTaP«OATaPE jSAVTAP.RMFlLEfBMWEY. 

MlSFIL.HlSr:EY»TRFORM,EWlPTP.ERPKEY»MAPUNT»NOFILEt 
nPUM4O,DPMwns.RAGSIZt0ATFrL»STAFIL»ASAV*ASAVFL 

•nhstun.nmstfI ,sctrun»mapfil 

.D0TUNT.00TFIL.NCHRAS*TRNSFL»8MTRFL»HlSTFLtPCHUNT» 
CRDUNT»RrTUNT,WANOIO 
C DATA  transformation  COMMON  BLOCK 

COMMON/TRBLCK/OUTFMT#NOFEAT»FLOINF(6)  * FETVECOO) 


CSEND 

C 

DIMENSION  CLSMTX(NOSUB2) 

C 

DATA  '^COTWO/'Z'/ 

C 

CNTs7»  (S*3*?*AV1  >*(  (4Vl^n>/12) 

CNTsPapSIZ/CNT 

TNC=CNT 

no  1 ICLASsl .N0SUB2 
IF ( INC.LT.CNT)  GO  TO  2 
WRITE (A, HEAD) 

INCsO 

? wRTTF(<^.3)  Cl.SMTX  ( ICLAS) 

3 FORMaT(/*  SUBCLASS  **A4) 
no  4 LOC=l.AV1.12 
GTOPrLOC*)) 

IF(STOP.GT.AVI)  ST0P«AV1 
A WRTTF(f>.5)  (AVFMTXd. ICLAS)  »I»LOC»STOP) 

5 FCRMAT<»  MEANi ,3X» I2F9.2) 

WRITF (6.6) 

6 FO»MAT(t  COVARI4NCF  MATRIX') 

CALL  WRTMTX (COVMTX ( 1. ICLAS) .AV1.8C0TWO) 
INC=INC*1 
1 CONTINUE 
RETURN 
END 


PRTOOOlO 

PRT00020 

PRT00030 

PRT00040 

PRTOOOSO 

PRT00060 

PRT00070 

PRT00080 

PRT00090 

PRTOOlOO 

PRTOOilO 

COMOOOiO 

COH00020 

COM00030 

COM00040 

CQMOOOSO 

COMOOOIO 

COM00020 

COM00030 

COMOOOIO 

COM00020 

COM00030 

COM00040 

COM00050 

COM00060 


PRT00130 

RRT00140 

PRT00150 

RRTOOisO 

PRT00170 

PRTOOIRO 

PRT00190 

PRT00200 

PRT00210 

RRT00220 

PRT00230 

PRT00240 

PWT002S0 

PRT00260 

PRT00270 

PRT002B0 

PRT00290 

PRT00300 

PRT00310 

PPT00320 

PRT00330 

PRT00340 

PRT003S0 

PMT00360 

PRT00370 

PRT003B0 

PRT00390 


riLFi  RANK 


C^iENfl 

10 

20 

30 

AO 

50 

60 

70 


7«* 

«0 


QO 

99 

500 

510 


SUBROUTINE  RANK(N0FE*T«FETVC2*LNCAT«MEANS*IPTT) 

IMPLICIT  TnT£GEW(A-X»  , 

• PrAL  NFANS(NOFFATtLNCAT) .SAVE, 6(60) 
pINENSlON  FETVC2(26> tlPTT(LNCAT) 

INCLUDE  C0M5K6 

C0MM0N/6L0BAL/HEa0(63) tMAPTAPtOATAPF »SAVTAP»BHFILEiBMKEY» 

Hl5FIL»HlSKEYf TRFORMtERIPTPfEPPKEV.MAPUNT.NOFILE* 
n9UMAn.nPNwOS.PA65IZ.DATFILfSTAFIL»ASAV.ASAVFL 
,NhSTllN,NH5Tr  I ♦SCT«UN,MaPFIL 

,r)OTUNT,OOTFIL.NCMPAS»TRNSFL«BHTRFL»HlSTFLtPCHUNT* 

CPOUNT»PRTUNT*PANOIO 

IF(moD(NOFEaT,4) ) 10t20*10 
weiTF (6.500) 

60  TO  99 

DO  30  I«1«L-NCAT 

IPTTd)*! 

continue 

DO  40  Jsl.LNCAT 

6(J)«0 

CONTINUE 

DO  50  1*1, NOFEAT. NCHPAS 
DO  50  J*1,LNCAT 

r,(J)*r,(  j)  ♦ (-0,2v»mF.ANS(I,J)-0.56«MEANS(1*1,J>*0.6*MEANS(I*2,J) 

•*0,49*wE4NS(I*3.J) ) 

continue 

3*0 

JsJ.l 

IF  ( j,r,T.LNCAT)60  TO  90 
IF(j.cQ.LNCaT)60  TO  75 
IF (P( J) .LT.6(J*1) )G0  TO  70 
r,0  TO  60 

SAVF=ri(  J) 

6(j)»r,(j*i) 

R(J*l)=SavF 
lSiVE=IPTT ( J) 

IPTT(J).IPTT(J»l) 

IPTT(J.I)*1SAVE 

K=J 

IF(K.Erj.l)60  TO  60 

IF (G(K) .LT.G(K-l) )GO  TO  60 

SAVFsG (K-1 ) 

G(K-1)=G(K) 

G(K) =5«VE 

I5AvF=IPTT (K-1 ) 

JPTT (K-1 ) =IPTT (K) 

IPTT(K) alSAVE 
K=K-1 
GO  TO  50 
CONTINUE 

WOITF  (6.510)  (I,  IPTTd)  ,6(1)  »I«1»LNCAT) 

CONTINUE 

RFTUPN 

FOWMaT ( IX, »THF  NUMBER  OF  CHANNELS  ARE  NOT  A MULTIPLE  OF  4. 

•THF  COLOR  KFV5  will  9E  OHDEHEO  BY  CLUSTER  NUMBER.*) 


format  dX,  'COLOR  KEY  • 
Enu 


il2,»  IS  CLUSTER  ',I2,'  GREENNESS*' ,F7. 2/) 


RANOOOlO 
RAN00020 
RANO0030 
RANOOOAO 
RANOOOSO 
COMOOOIO 
COH00020 
COM00030 
COM00040 
COMOOOSO 
COM0Q060 
RAN00070 
RANOOOBO 
RAN00090 
RANOOiOO 
RANOOl 10 
RAN00120 
PANOOiSO 
RAN00I40 
RAN00150 
RAN00160 
RANOOl 70 
RANOOIHO 
RAN00190 
PANOQ200 
RAN00210 
RAi^00220 
RAN00230 
RAN00240 
PAN00250 
RAN00260 
RANO027O 
RAN002P0 
RANA0290 
RAN00300 
RAW0031 0 
PAN00320 
RAN('0330 
RAN00340 
RAN00350 
MAN00360 
RAN00370 
RANO03H0 
RANn0390 
RAN00400 
RANflOA 1 0 
HAN004PO 
RANOO<*30 
PAN00440 
RAf, 00450 
(MNO0460 
RAN00470 
RAN004R0 
RAN00490 
RAN00500 
RAN00510 
RAN00520 


FRrs  ROnOTS 


c 

c 

c 


r 

f 

c 

c 

c 

c 


UTILITY  ROUTINE  THAT  READS  THE  OOTFIL 

• NOFLn.TOTvOT,FLnSAV.VERTEF./liVAH/T 
IHRLICIT  lNTf<5FH(A-2> 
ni*'FNS10N  KVAR(S1?ES«1) 


n 

REAL  KVAR 

TYPShT 
TYP^rT 
TypsrT 


1 -RFTURO'S  spectral  INFO 

? -RFTUH^'S  SPAT'  ■ 

3 -returns  both 


AND  SPECTRAL  INFO 


:$FNo 


DATA  HLANK/t  1/ 

COMVoN/f'LOBAl/HFirMfA)  «MAPTAP»OATaPE»SAVTaP«BNFILE»BNKEY» 

Hisr  ILfHlS*'EY»TRFORM,ERIPTP*ERPKEY»MAPUNT*NOFlLE» 
OaiMAO.f)RH,<l)StPAfiSI2.nATFlL»STAFlL»ASAV»ASAVFL 
,NH^Ti)N.NHSTFl«SCTRUN«MAPFlL  . _ 

.nOTiIMT .nOTF  TL.nChRAS*TRNSFL»8MTRFL»HISTFL*PCHUNT • 
CH0UNT*PHTUNT»RAN010 


c 

c 

c 


c 

c 

c 

c 

r 

r 

r 


n I PENS  TON 
Ol’^FNSlON 
niMFNSTfiN 
ni**ENS10N 


CATNAm(U .DOTVEr (1» ♦OOTStSlZESjl) 


FETVECOO) » 
FLriSAV(4.1) 
TEHDOT(SOOO) 


FETVC3C'0>  »FETVC2i| 
#VERTEX(2.l) ♦ANGLE! 


» 

I) 


READ  PEC  NO.  1 FOP  INDICES 

REWIND  r.OTUNT  . _ 

CALL  FSBSFLIOOTUNT.OOTFIl. ISTaT) 

PF  AO  (OOTUNT  ) NOr.AT  .NOEF  AT.NOFLOfTOTVRTtTOTDOT^NDSUNf  (CATNANI I ) ♦ 
► 1«1  fiiOCAT)  .SIZE 

CO-^PiiTE  ADDRESSES  FOP  APPAY 

OOTSl  » 1 

HEAD  PEC.  NO.  2 


IE 

TE 

IE 


(TvPSwT  ,E0.  n RE  AO (OOTUNT) (FFTVEC ( I ) ♦ I«1 *NOFEAT) 
(TVPS..T  ,EQ.  i>)  WEAO(DOTUNT)  DUMMY 

(TyP<AT  .EQ.  .1)  hEAOUJOTUNT)  (FETVECI  I)  tljltNOFEAT) 

. ( (FLi'SflV  ! I » J)  . Isl  .<•)  ♦ J»1  fNOFLD)  ♦ < (VERTEX  (IfUItlsltZIf 
jc1 .TOT VhT) . (ANOLE (I) . 1=1. NOSUN) 


C 

C 

C 


IE 

IF 


(TvPS*T 

(NOEET2 


.EU. 

.NE. 


2) 

0) 


60 

60 


TO 

TO 


H7 

60 


«;n 


An 


70 

7S 

C 

, «rn 

A7 

C 

c»** 

c«*» 

c 


PDDOOOlO 

PUPOOOPO 

R0n00030 


)0506( 


EFT  default  channels 

no  HO  I = l.f40EEAT 
FETVfVd)  = I 
FfTV'-'Ml)  = 1 
MOrFT2  = NOFEAT 
SO  TO  R7 

no  «0  Jrl.NOEET? 

no  70  KiI.nOFEaT 

IF(  FFTVFC(K)  .FO.  FETVC2U))  GO  TO  7S 

roT'iT  if.uf 

WRTTP  (♦'.hS)FFTVC2(J)  .(FETVFC(n.l»l.NOFFAT)  - .oc. 

EOBMiTI//'  channel  '.I2*'  is  NOT  ON  OOTFIL*/  * CHANNELS  APE*. 301 
CALL  CM*HH 
EETVC.T(J)  « K 


rONTINliF 
IF  (TDTUT1 


.EO.  0)  60  TO  96 


CODE  ADDED  N(*V  21*  1978 
IE  (TUTITTI.OT.TOTOoT) 
DO  9S  .)=1,T0T0T3 


FOR  LIST  PROCESSING 
TOTDT3  * TOTDoT 


PpOO! 

POD0()070 
RDDOOOAO 
RD000090 
RpDOOlOO 
mdoooiio 

ROOOOl 
RUOOOiso 
RDO00I60 
PCID00170 
RODOOiBO 
RDOOOI9O 
RDOO0200 
RDDOOZIO 
RDD00220 
RDD00230 
RDO002A0 
RUD002S0 
RD000260 
RDU00270 
ROD00280 
RD000290 
RDD00300 
PDD00310 
HDDO0320 
RDD00330 
ROi)(i03A0 
P()D003SO 
RC»D00360 
ROD00370 
PDU00380 
HU000390 
RUDOOAOC 
BDDOO<tlO 
HL/D0OA20 
PDD00430 
RDDOOH40 
HU0004SO 
PD000460 
PDD00470 
PDDC04P0 
RDD00490 
PDDOOSOO 
ROOOOSl 0 
PUOOOS20 
PDO00S30 
PDD00S40 
BD000550 
ROD00S60 
PDO00S70 
POOOPSftO 
HOOOOS90 
PDD00600 
RDDOOGIO 
POCC0620 
RDD00N30 
PDD00840 
WDD006SO 
EOD0O6N0 
3IHDn00670 
BlniODfthO 
WDD00N9O 
HD0007nO 
pononno 
Ht)|)007?0 
RDD00730 
Rfin00740 
PD(1007SO 
P(»li007N0 
wrinoo77o 
NOD0O780 
ROD00790 


oon  n o — rv->r> 


FILPJ  »OOOTS 


IF 


. fnoTVFrnj  .LE.TOTOOTI  60  TO  <»5 
w»njri*i.«>0)0nTv€CU>  tTOTOpT 


««  F0OM«T</  * OOT  NU. 
• • COTS*  » 

CALL  CHfSh 
CONTTNUF 

«6  Continue 


IS  NOT  ON  OOTFIL*/  • FIlC  CONTAINS  •♦13. 


«6A0  9FC  NO, 3 — nOTS 
total  « SIZE  **  TOTQOT 

PEAO<nOTUNf ) (TEMOOT (OOTSl-1 *I )♦ I>1 .TOTAL) 


C 


IF  ITYPSwT  .FO.  1 

) 

60 

TO 

1 

F (TyPS-T  .FO.  2 

» 

60 

TO 

|o 

F (TYPSaT  .00.  3 

) 

60 

TO 

so 

RETRIEVE  spectral  INFO 

30  rONTINtiF 

,«;I7ES  = NOFFT? 

TOTOT?  s T0TPT3 

CALL  wnri.iT  I (TEMOOT, DOTS. KVAP. SIZES. TOT0T2.O0TVEC.FETVC3. 

• 5!ZF.TOT'3UT.TOTdT3.NOF£T2.TYPSWT) 

RETURN 

PETRKwF  spatial  info 

50  rONTINUF 

a^TOTPOT 

CALL  ROnnTl (TF-nOT, DOTS. KVAR, SIZES. TOT0T2.0OTVEC.FETVC3. 

• SIZF.loTO'jT.TOTun.NOFETp.lYPSWT) 
return 


1 


AO  CONTINUE 

retrieve 


srfctral  ano  spatial  info 


SI7FS  a SI7.P 
TOTOTZ  = TOTOOT  - 


IOTOT3 


CALL  .^nf'OTl  (TEPPOT, DOTS. KVAR, SIZES. T0TDT2.00TVEC.FETVC3. 
» SIZE.TOTnOT,TOTnT3.NOF£T2.rvPSwT) 

RETURN 

END 


RPPOOAOO 

RDOOOMlO 

RDOOO02O 

Rpr»OO03O 

ROOOOtfAO 

RODCO0SO 

w5n00A60 

pDoooeTo 


RUnOOAAC 
R0OC0O90 
Rpp00900 
ROOOORiO 
ROO00V2O 
ROD00930 
R0Q009A0 
R|)p00950 
Rp506960 
ROpO09T0 
RPD009AO 
R0p00990 
RDOOIOOO 
RDOOIOIO 
ROOD  1020 
POOOI030 
ROOOiOAO 
R0001050 
RODOlOfeO 
ROD01070 
RDOOlOflO 
Pf)001090 

RUDonoo 

RODOniO 

ppooiipo 

WL)D01130 

poooiUo 

PDDOilSO 
PDD01160 
RnnoiiTo 
PfjUOl  lAO 
PDO0n90 
RU001200 

Rnooizio 

RD00J??0 

R0001230 

ROOOIZaO 

POpOlZSO 

RD0012NO 

R0001270 


rir>">  o ri  —nr»r»  r»or»  or>r> 


FILE:  t»OnOTl 


C 


C 

C 


SU«ROUTIKC  HOnOTl (TEi-D0T.n0T5»KVAfr.SI7C5.70T0T?.00TVtC.FtTVC3. 
• SlZe.Tjt)TOOT,TOTOT3.NOrET?.TYPS«T) 

IMOLKIT  INTEREH  (A-?> 

niMfNSfON  TE*inOT(n»6oTS<SI2ES.n»007VECa).F£TVC3<n 
REAL  KVAR«ST7I^S»n 

TVRSRT  -I  — RETRIEVE  SPECTRAL  INFO 

« 2 — retrieve  spatial  info 

« 1 — RFTN.IEVE  SPECTRAL  ANO  SPATIAL  INFO 
GO  TO  (]30tlS0f IRO) «TyPSrT 


RETRIEVE  spectral  INFO 


I3G  CONTINUE 

PICK  SUBSET  OF  DOTS  ANO  CHANNELS 


no  140  k»I.T0T0T2 
KK  » 1)0TVEC(M 
no  140  Js). SIZES 
JJ  « FFTVCKJ) 
jJ.I  »(Kf<-l)»ST7F  ♦ JJ*4 
KV4rt<j,K)  3 FLOAT (TEHDOT(JJJI) 
140  rONT I NUt 

return 

RETRIEVE  spatial  INFO 


SO  CONTINUE 

no  ITO  I*1.T0TDT2 
4K  3(I-i)*SIZt' 
no  170  K3l, SIZES 
170  (>OTS(K,I)  3 TEMOOT(KK*K) 


return 


IPO  CONTINUE 

retrieve  spectral  ANO  SPATIAL  INFO 


)J  3 n 

4K  3 1 

no  300  K3l,TOTnOT 

TE  (rk.UT.  T0T0T3)  GO  TO  190 

IE  (K  .NE.  nOTVEC(KK))  GO  TO  190 

KK  3 KK*1 

r-0  TC  300 

100  JJ  3 JJ  ♦ i 

JJJ  3 (K-J)«S1ZE 
I'O  ?0n  jml,* 

200  noTS(J.JJ)  ■*  TEmOOT  (JJJ*J) 

no  210  JS1.N0FET2 
I 3 FfTVC3(J) 

?in  nnTS(A*j,jj)  3 TEHDOT ( JJJ*4*I ) 

300  rr.MiNuf 

return 

END 


Ronoftolo 

R0000020 

ponoooso 
PDnooo40 
RDpnoOSO 
RfinOOONO 
R0000070 
WPOOOOIIO 
Rf.>000090 
ROOOOlOO 
Rpoooi 10 
RQOOOiZO 

pnoooiso 

R0000140 

RpOOOlSO 

RL000160 

RDOOOlZO 

PDOooieo 

ROO00J90 

R0000200 

pnooo2io 

Rnnoo220 

ROD00230 

P0000240 

HpO00250 

R000n2i',0 

Rf>r)00270 

Rf'OOC2«0 

roooo2<;o 

ROD00300 

RUD00310 

POD00320 

WCD00330 

RUU00340 

R00003SO 

R(itJO03O0 

Rl)000370 

RD0003BO 

fiutmojoo 


R0000400 

RimnoAio 

Ru0004?C 

RDOOO-IO 

ROD00440 

Rr-I)004b0 

Pt^DOOANO 

Rnnoo470 

ponooABO 

RDf)00490 

RUOOOSOO 

wunocM  0 

RDU00S20 

RDOO0S30 

pnooobAo 

RDOOOSSO 

Ronoosoo 

pnoposTo 

wnopospo 

wnDPOb'yf) 

P00li(if>00 

PUOOOhlO 


FILE:  ROMEAN 


C* 

C* 


CSEND 


in 

non 

510 


SURROUTINE  ROMEANIMENS) 

IMPLICIT  INTEGER (A-X) 

THIS  SUBROUTINE  READS  THE  'MEAN*  CARD  DECK  OR  FILE  FOR  ISOCLS. 

INCLUDE  C0MRK4.LIST 
INCLUDE  C0MI»K5*LIST 
INCLUDE  C0MRK6.LIST 

DIMENSION  HEDI  (15)  .HE0?<15)  .DATEO)  ♦COMENT(IS) 

EQUIVALENCE  (HEOl (1) ♦HEAD<4) ) . (DATE ( 1 ) *HEA0<22) ) . 

2 (HEf)2(l)  .HEAOOO)  ) . (COMENTd)  »HEA0(A8)  ) 

COMMON/PASS/STOP »LNCAT»NMIN,KRN,STDMAX.0LMIN»|EP» 

HAP»SPTRI6.  IRQ.  KPfS.  NOPTS*  PUNCH, 
ICMN,CHNTH5,ICHflIN(62) ,NWDS, IBEGIN.PEGINJ , 

BF61N?,BE6IN3,CLSNAM,N0EL0t IPT,T0TWR0*T0TPTSt 
NCL45S,NOCLS,TOTSUB,TOTFLD,TOTVRT,NOCL»NVRT 
,NXTCL5, nofeat, HAXCLStFETVECOO)  ,SYMMTX(62) 
,VAREI?,STaTky.ISOKEY,HAPFMT,MAPKEY,SEOUEN{20) ,percen,simerp 
,inPDFP. IHUNIT. lNriLE,INlTM.PMIN,SU8VEC(62),NOSUB2,CHNVC(30) 

, NOCHAN, tRC0HP,NOSEQ. ME ANOO, ME ANDU, 
SYMn0.SYMmi,ITRl60.1T«I6U,D0FLAG, 
miFLA6.DODl),STOOTS(50)  ,NSDOTS,SUNCOR(30)  »LLNCAT, 

OVERT ( 25 n, 2) ,0RECT(60»2) ,0VPNT ( 1 1 ,2) , lOCNT (2) ,N00U(2) 
,MXFFT1.M6XP0P 
peal  SUNCOR 

C0MM0N/G^'''’AL/HEAD<63)  ,MAPTAP,DATAPE»SAVTAP,BMFlLEfBMKEY, 

HISFIL.hI5KEY,TRF0RM,ERIPTP,ERPKEY»MaPUNT,N0FILF, 

nRUMA(.!,nPM«OS.RAGSIZ,nATFIL,STAFIL,ASAV,ASAVFL 

.NH5TUN,NHSTFI,5CTPUN,MAPFIL 

, DOTUNT , ODTF I L . NCHP AS , TRNSFL  * BMTRFL , H ISTFL  f PCHUNT , 
CRDUMT,PRTUNT,HANDI0 


II 


c 

c 


c* 

c* 


12 


COMMON/PASSA/NOFETI  ,r  TVECK30) 

OIMFNSTON  mens (30,1) 

READ(CPOUNT.‘^On)  LNCAT,N0FET1 , (FTVECl  (I)  , 
no  in  T=1.LNCAT 

PEaDCCPOUNT.SI  0)  <RF.NS(J,n»  Jsl,NOFiTl) 
format (SX, 15, 15X,I5/5X,30I2) 

FOdmat (5X.5f15,8) 

A0DRES=16EGIN 

CALL  PWRITE ( ADORES, LNC AT, l.LSTAT) 
AnnPEs=ADnPES*i 

CALL  R«RITE( ADORES, NOFET 1,1, LSTAT) 
AOnPES=AOriRES+l 

CALL  RWRITE< AOOPFS, FTVECl, N0FET1,LSTAT) 

AODRES=ADnRFS*NOFET 1 

Kw=MxFFT1»LNCAT 

CALL  Rwp I Tt (ADORES fMENSfKW.jSTAT) 

IF(JSTat.£Q.1)60T0  11 

return 


FNTRY  RDFILE (MEANS, MENS) 

dimension  means (NOFE at, MAXCLS) 

A0MRES  = I8FGpj 

CAl.L  RPEAO(aD0RES,LNCAT,1,LSTAT) 
ADDRESsAOPRES*! 

Call  RREAn{ADOMES,NOFETl , l ,LSTAT> 
ADnPES=AOPRF5,l 

CAl.L  PPEAOl  ADORES, FTVECl  »N0FET1,LST AT) 

AOnPFS  = eOI)RFS  + N()FETl 

KWsMXFFTl^LNf.AT 

CAl L RREAO(AnncES,MENS,KW,JSTAT) 
IF(JSTAT,F.f).l)GOTO  12 

STORE  ONLY  CHANNELS  REQUESTED  IN  FETVEC 


UlfNOFETl) 


IF ( L NC AT, GT. MAXCLS )LNCAT=MAXCLS 

no  40  vI=i»noffat 
no  3n  M=i,rjnFETi 

IF(FFTVEC(0) ,N^, FTVECl (K) )60  TO  30 
no  20  I=1,LNCAT 
20  meaNS(J,I)  = HENS(K,I) 

RO  TO  40 
30  rONTiNUF 

WRTTE(5.100)FETVEC(J) 
no  35  1=1.LNCAT 
35  MFANS(J,I)  = 50.  ♦ 1*10. 

40  CONTINUE 


ROMOOOlO 

R0H00020 

RDM00030 

rdhoooao 

HOM00050 

RDM00060 

H0M00070 

ROMOOURO 

COMOOOlO 

COH00020 

COM00030 

COHOOOlO 

COM00020 

COM00030 

COM00040 

COM00050 

COMOOOHO 

COM00070 

COHOOOPO 

COM00090 

COMOOroo 

coMoon  0 

COMOOlPO 
COM00130 
COM00140 
COHOOOlO 
COM00020 
COM00030 
COM00040 
COM00050 
COM00060 
ROMOOlOO 
ROMOOllO 
POM00120 
ROM00130 
RDM00140 
RDM00150 
RDM00160 
RDM00170 
WDMOOlflO 
RDMOOIRO 
RDM00200 
RDM00210 
ROH00220 
ROM00230 
WOM00240 
PUM00250 
ROM00260 
RDM00270 
ROM00280 
ROM00250 
ROM00300 
ROH00310 
RDM00320 
ROM00330 
RDMC0340 
RDM00350 
RPM00360 
ROH00370 
RDM00360 
RPM00390 
RUM00400 
ROM00410 
R|>i004?0 
RDM00430 
ROM00440 
kOM00450 
RIIM00  4 60 
RDM00470 
Rt)M004P,0 
RDM00450 
ROMOObOO 
RpMOObl 0 
»OM(10520 
RPM00530 
ROMO  054  (I 
ROM no 550 
RUMOOSbO 
POM00570 


♦ • 


FILEt  RDMEAN 


PRINT  INITIAL  CLUSTER  CENTERS 

C* 

WRITE(6»200) 

TB*l 

!F=12 

45  IF(NOFFaT.LT.IE) IE=NOFEAT 

WRITF(5,300) <FFTVECtJ) iJ=IByIE) 
no  sn  i=i,LNCAT 

«^0  uRITF((S.400)  I.  (MFANS(J*I)  »JsIB»IEJ 
IF(IF.FO.NOFEAT)eO  TO  60 
IR=IB*12 
IF=IE*12 
fiO  TO  45 
60  PFTURN 

100  FORMATC  means  FOR  CHANNEL •» I4t  • ARE  NOT  ON  FILE 
*L  RE  MSEO») 

200  rOOMAT(///l‘^X»»IMTlAL  CLUSTER  MEANS*/) 

300  format (2X« 'CLUSTER*. 2X. 12 ( IX. *CH(*, 12* •)*. IX) ) 
400  F0RMaT<5X,I2,5X,12(F6.2.2X) ) 

FND 


ROM00580 
RUH00590 
ROM00600 
RUM00610 
ROM00620 
RUM00630 
RUM00640 
ROM00650 
HOM00660 
PDM00670 
ROM00660 
ROM00690 
WOM00700 
ROM0n710 
RDM00720 
DUMMY  VALVES  WILRDM00730 
RDM00740 
RDM00750 
RUM00760 
PDH00770 
PQM007e0 


FILFs  PO^OOK 


CCOOPPYY 

SUBROUTINE  fiOMOOKI AVAR. COVAR.CLSDES.SUBNO.SUaOEStFLOSAV. VERTEX* 
• ARRAY) 

implicit  integer  (A-Z) 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

r 

c 

c 


READ  in  rest  of  module  DECK  AND  STORE  IN  THE 
FOLLOWING  manner  ; COVARIANCES 

' MEANS 

' CLASS  DESCRIPTIONS 

NO  OF  SUBCLASS  IN  EACH  CLASS 
SUBCLASS  DESCRIPTIONS 
FIELD  INFORMATION 

verticies 

AND  WRITE  SAVTAP  FILE 


C 

C 

C 

C 

c 

c 

c 

c 

c 


CSFND 


C 

C 


C 

C 

C 


INCLUOF  COMPKI.LIST 
INCLUDE  COMaKA.LIST 

COMMON/ INFOPM/NOCl.SZ, NOSUP?. NOFET2.VARSZ?. TOT VTP.NOFLO?. 

• AVAR?,COVAH?,CLSIO2.SU0NO?.SUBOS?.FlOSV?.VERTX?. 

• FETVC?(30) .SUHVC?(7S) .SUHPTR(75) .CLSVC?(60) . 

• KEPPTS(ftO) .NOGRP.GkPNAM (60) .GRPOEX(6D  * 

* GRPCHK(61) .GR0UPS(i?A) 

C0MM0N/GL08AL/HEArXh3) .maptap.datape.savtap.bmfile.bmkey. 

♦ HISFIL.hISKEY.TRFORk.ERIPTP.ERPKEY.MAPUNT. NOFILE. 

♦ nRUMAD.nRMwDS.PAC'SIZ.UATFlL.STAFlL.ASAV.  ASAVFL 

* .NHSTUN.NHSTFI .SCTPUN.MaPFIL 

• .DOTUnT.OOTFTL.NCmPAS.TRNSFL.BmTRFL.HISTFL.PCHUNT. 

* crdunt.phtunt.hanoio 

COMMON/PASSP/NOCLS.NOSUB.NOFEaT,NOFLD.TOTVRT.FETVEC(30) » 

• FL05V1.CLSID1 .VARSIZ 

dimension  COVAP (VARSIZ) .AVAR(NOFEAT) .CLSDES(NOCLS) .SUBNO(NOCLS) 

• S'MDFSiNOSUP) .FLDSAVIA.NOFLD) .VERTEX (2. TOTVRT) . 

* ARPAY(l) 

real  covar.avar 
rewind  SAVTAP 
IF  (STAFIL  .FO.  O) 

POSITION  ST AT  TAPE 


GO  TO  1 

TO  DESIRED  FILE 


CALL  FSBSFL (SAVTAP. STAFIL. ISTAT) 

IF  (ISTaT  .FO.  0)  60  TO  1 

FILNO  = STaFIL  ♦ 1 
•-IPTTF  (*>.?un)FILNO 

?<30  format  (//  IS. 'ERROR  IN  TRYING  TO  POSITION  STAT  FILE  TO  FILE  *.I3. 
* • IN  CPOSTA') 


C 

r 

C* 

C 


I IF  (ISTaT  .GT.  0)  60  TO  3 

WRITE (SAVTaP)NOCLS.NOSUo. NOFEAT. NOFLO.TOTVPT. (FETVEC ( I ) . 1 = 1 . 
• NOFEAT) 


IF  ISTAT 
stat  deck 


IS  NOT  ZFRO. 
WILL  PE  READ 


The  file 

TO  CHECK 


CANNOT  BE 
FOR  INPUT 


WRITTEN. 

ERRORS. 


BUT  THE  MODULE 


CONTINUE 
K?  s 0 

no  5 J=l.NOELP 

RFAD(rPDUNT.?15) (FLOSAV(I.J)  .1  = 1.4) 

K1  = 1 ♦ K? 

K?  = M ♦ FLnSAV(4.J)  - 1 

READ (COUUM .220)  ( ( VERTEX!  I, K) . 1 = 1 .2) .K=K 1 ,K2> 

IF  (ISTAT  .GT.  0)  GO  TO  5 


WPTTE (S AvTa J) 
wRTTF  (‘=AVTaP) 
rONTINUC 
RFAD (CHDUNT.PGO) 
PPAn(CHPurjT,?AO) 
READ(ChDU\T.2S0) 

IF  (ISTAT  .GT.  0) 


(FLOSAV(I.J) .1=1,4) 

( ( VERTEX ( I ,K) , 1 = 1 ,2) ,K=Kl,K2) 


(CLSOFSd!  ,I  = l,NOCLS) 
(SUPNl)(  I ) . 1 = 1 .NOCLS) 
(SUHULS ( I ) . 1=1 .NOSUB) 

GO  TO  7 


ROMOOOlO 
ROM00020 
ROM00030 
ROM00040 
RDMOOOSO 
RDM00060 
ROM00070 
PDMOOOeO 
RDM00090 
ROMOOlOO 
ROMOOllO 
ROM00120 
HDM00130 
RUM00140 
ROM00150 
RDM00160 
RDM00170 
HUMOO180 
ROMOOIRO 
PDM00200 
HOM00210 
ROM00220 
ROM00230 
RDM00240 
RDH00250 
ROM00260 
ROH00270 
RDM002BO 
RGM00290 
ROH00300 
HDM00310 
RDMO0320 
RDM00330 
POMOO340 
HDM003S0 
RQM00360 
RUM00370 
RDH00380 
ROH00390 
RDF  OOaOO 
RDM00410 
POM00420 
PDM00430 
Rr)M()0A4  0 
RDM004S0 
RDM00460 
RrtM00470 
WDM004a0 
RDM00490 
PDMOOSOO 
RDM00510 
RDM0OS2O 
RDM00S30 
RDM00540 
RDMOObSO 
RDMOOSGO 
PDF-0nS70 
R(JMOOSHO 
RDM00S90 
RDFiCOGOO 
rDVOOhI 0 
RnM00620 
ROM00h30 
RUMOOhAO 
PDMOOfrSO 
WOmOOGGO 
ROH00b70 
RU-^OObHO 
HC'RiOObRO 

rohootoo 
PP«0U710 
P('M007?0 
ROHOn  730 
RiiMno74o 
RftM007SO 
RO‘^00  !^0 
RO'100770 
M)R00780 
RD«00790 


FIL^S  OOMODK 


C 


C 

Cl 

Cl 

Cl 

c 


SUPO?  « FLOSVl  - 1 

wHTTF(<;aVTAP>  (ARRaY(I)  (IsCLSlOlfSUBOZ) 

7 CONTINUE 

mean?  a CLSlOl  - 1 
no  10  Tal.MOSUn 
PFAD(CH0UNT,2«.0)  KEPPTSd) 

PEA0(C}<DUNTt2»0)  (AVAR(J)  tJrl, NOFEAT) 
PEA0(CP0UNT.2<<0)  (COVAP(J)  tJaltVARSIZ) 

IF  <1STaT  ,6T.  0)  'go  to  10 

WPITE(SAVTAP)KEPPTS(1) * (ARRAY(J) *Jal,ME«N2) 
in  CONTINUE 

IF  (ISTaT  ,GT.  0)  STaFIL  * -1 
IF  (ISTAT  ,GT.  0)  RETURN 

FNH  FILE  5AVTAP 

return 

?15  FOBMAT(A4.t»X.I?»eX»I2.0X»12) 

2?0  FORMAT  (inx,1415) 

?30  format  ( (hX»<J<2X.A4,2X)  ) ) 

?A0  FORMAT ( (7X,?4 (IX. 12) ) ) 

?en  F0RMAT( (fiX.10(A4.3X)  )) 

;>f,n  FnRMAT(12x.i«) 

270  FORMAT  (6X.12F6.2) 

?flO  format-  (SX.SElS.e) 

ENO 


KDMOOeOO 
ROmOOBIO 
ROM00B20 
ROM00830 
RUM00840 
ROM00850 
ROM00860 
ROM00870 
POM00880 
HOM00890 
ROMOOVOO 
ROM00910 
RUM00920 
RDM00930 
ROM00940 
RDH00950 
ROM00960 
CIROH00970 
POM00980 
ROM00990 
RDMOIOOO 
ROMO  1010 
PDM01020 
ROM01030 
MOM01040 
RDMOIOSO 
HDMOIOOO 
PDM01070 
R0M01080 
RDM01090 


nrtn  nnnrt  nr»  nnr>  nnr>  non  r»  oooorjoooooo 


FILEI  R£-nO*T 


«;URROUTINE  PEOnAKCOVAH.  A Vft‘^»CLSUFSt SUBNO.^^USOES.FLOSAV.  VERTEX* 

* COV.AVEN*CLS0S«SUfl»JOS«SUR0S*FL0SV.VERTXt 

• NOEEAT*VARSI2»NOCLS.NOFLn.NOSU8»FETV;'C) 
IMPLICIT  INTEGER  (A-Z» 

OIMENSION  EFTVECOO) 


READS  COVARIANCES  AND  MEANS  FROM  FILE  AND  REDUCES  STATS 

*•**•*•^**••*•*•♦•••••****•*• 


«ENO 


TNCLUOF  COM^kI.LIST 
INCLUDE  COM'^KG.LIST 

C0MM0N/INEOPM/N0CLS?tN0SU82tN0FET2tVAPS22.T0TVT2»N0EL02« 

* AVAR2,COVA«?.CLSID2.Susn02.SU8DS2»FlOSV2.VERTX2» 

* FF.TVC2(30)  «SURVC2(  7S)  »SUbRTR{7S)  .CLSVC2I60)  t 

* KEPPTS(60> ♦NOGRP»GRPNAM(60) tGRPDEX (6l) * 

* GHPCHK (61 ) f GROUPS < 12A) 

C0MM0N/6L0yaL/REAn(63» ,HAPT AP*OAT APE . SAVT AP»BME lUE »8MKE Y.  ^ 

* HI5EIL.HlSKt'Y.TRE0RM»FPIPTP»ERPKEY.MAPUNT,N0FlLE« 

* ORIIMAD»nRMwoS»HAGSIZ*DATElL»STAFlL»ASAV*ASAVEL 

* .NHSTUN,NhSTEI,SCTRUN»MAPFIL 

* ,OOTUNT.DnTElL*NCHPAS.TRNSFL»BMTREL*HlSTFL»PCHUNTt 
CRDUNT*RRTUNT.RANOIO 


COMMON/RFSTKN/KPPPTS(60) » iprior»kbfst*ncpass  . . 

REAL  COVAR( VARSZP.NOSUa?) , AV AR (NOFE AT *N0SU8 ) .COV(VARSIZ) » 

* ■ aVFN(N0FET?.N0SUP2» *R 

DIMENSION  CLS0F5(N0CLS) .SU«NO (NOCLS) .SU8DES (NOSUS) «CLSOS (N0CLS2) • 

* SU->N0S(NUCLS2)  ♦SUPDS(N0SUH2)  .FLDSV(4»N0EL02)  . 

♦ VFRTX (2.TOTVT2) .ELDSAV (AtNOELD) v VERTEX (2»TOTVT2> 

• .DUMVECOO) 


REDUCE  CLASS  DESCRIPTION  AND  ARRAY  CONTAINING  NO  OF  SUBCLASSES 

DO  ISO  I=l.MOCLS2 
CLSOSd)  = CLSDESd) 

ISO  SUPNOSd)  = SU“NOd) 

DEDUCE  SUBCLASS  DESCRIPTIONS 

no  160  I=l.MOSUR2 
160  SURDS  d)  = SUBOESd) 

REDUCE  FIELD  INFORMATION 

DO  no  I = 1,N0FLD2 
on  170  J=l,4 

170  FLnSVCJtl)  = FLUSAV(J*I) 

PEDUCF  VERTTCFS  , 

DO  IRO  I=1,TDTVTS 
nn  190  J=1.2 

180  VFRTX(Jtl)  = VFWTEX(J.I) 

7FR0  OUT  JUST  PORTION  OF  COVAR  THAT  WILL  CONTAIN  SUBCLASSES 
THAT  HAVE  HEEN  GROUPED 

DO  200  J=l.U0r-RP 
Kp  = r-RPDEx(J)  ♦ 1 
KF  = KR  * G-’OUPS  (KH-1  ) - 1 

IF  (KR  .GE.  KF)  GO  TO  200 
KK  = SUPPTRIKti) 

no  ns  LL  = )tVARsz2 

IPS  CDVAR(LL*KK)  = 0.0 
200  CONTINUE 

CHFC*<  classification  CHANNELS  AGAINST  TRAINING  CHANNELS 


no  220  Jsi.ndfft? 

DO  210  L=l.N0FtAT 

TF  ( FPTvr,2(vD  .FQ.  FETVECIL))  GO  TO  220 
210  CONTI NUk 

WRITE  (6.23(1)  FETvC2(J)  . (FFTVECOd  *K  = 1 • NOFFAT) 

230  P0DMAT(«  *«  f‘-Ai\''i)^^L  NO.  ‘.n**  IS  !■ ' . A TRAINING  CHANNEL  •*•/ 
• 40X  . dRA  IMnc-  channels  are  * '/  10X.30  (12*  IX)  ) 


PEOOOOlO 

RFD00020 

RE000030 

RE000040 

PEOOOOSO 

RED00060 

RED00070 

REDOOOBO 

RE000090 

REOOOlOO 

REooono 
RE000120 
RED00130 
PED00140 
RED00150 
DE000160 
DED00170 
RE000180 
REO00190 
RE000200 
RE000210 
RED00220 
HED00230 
PED00240 
Pt000250 
Pf 000260 
RED00270 
RE000260 
PED00290 
DE000300 
DE000310 
WFD00320 
PE000330 
DE000340 
RED003SO 
RED00360 
RE000370 
RE0003PO 
PED00390 
PE000400 
REQ00410 
RE000420 
RE000430 
RFD00440 
RED00450 
RE000460 
PED00470 
RE0004RO 
HED00490 
REDOOSOO 
RE000510 
REO00S20 
PE000530 
RE000540 
RE000550 
HFOOOS60 
DEO00S70 
RED00580 
KtOOOSRO 
RED00600 
PE000610 
RE000620 
RE000630 
PED006<.0 
PEU006SO 
PF  D00660 
FE000670 
Pt  000690 
PE  nOObPO 

p tooo  /no 

>^Ef'0071O 
PEt'00720 
PM  no  730 
PF  000  740 
PFI)0n7S0 
PF  ( '00760 
P’Fn0O7  7O 
Pf  000780 
»F  1)00790 


r>r>'o  r>nr» 


FILfS  PEnOAT 


22ft 

C 


8 


4fl 

?ft 


CALL  EXIT 
miliVEC(  J> 


no  10ft  JJ» 
fpis  - 


« L 


1* NOSUB 

CLASS  A MEMBER  OF. SELECTED  SUBCLASSES 


IS  T»-1S  SIM _ __  ^ _ 

IF  (SIIPPTR<JJ)  ,LE.  0)  WEAO(SAVTAP)  DUMMY 
IF  (SUPPT^MJJ)  .LE.  0)  GO  TO  100  „ . 

REAO(SAwTAP)K£PPTS(JJ>  »COV« ( AVAR ( 1 ♦ JJ) tl»ltNOFEAT) 


BY  CHANNELS 

3 SUPPTRUJl' 

J=1»N0FET2 
K r OUHVEC<J) 

LOr  = K*(K-l>/2 

on  4 0 i.=  l«v' 

WAT  = LOC**'oUMVEC(L) 
COV(KK)  = COV(WAT) 
AVAR(J.JJ)  s AVAR(KtJJ) 


REDUCE 

NEWSIM 
KK=  0 
DO  ?0 


r-Rnijp  SUBCLASSES 

IF  (GPPCHK(JJ)  ,LE.  0)  GO  TO  60 
KK  = 0 

DO  SO  Jl=ltN0FET2 

nn  so  J2=i.ji 

KK  s KK  ^ 1 

R = COVA«(KK,NEWSUB>  , . . 

COVAR(KK.NEwSUB)  = R ♦ (COV(KK)*(KEPPTS< JJ»-1) ) ♦ 

* (AVAR«J1»JJ)*AVAR(J2« JJ)«KEPPTS(JJ) ) 

Sft  FONT  I M IF 

no  TO  100  ■ 

f.0  on  70  I=1.VAHS72 
70  FOVAH( t .NEWSUB)  = COV(I) 
ion  CONTINUE 


GROUP  MEANS 

no  l?s  I=1,N0GRP 
‘ KO  = GPPOEa(I)  ♦ 1 

KF  = KP  ♦ GROUPS (KH-1)  - 1 
KRl  = GPOUPSIKP) 

IF  (KP  .GE.Kf)  GO  TO  130 
00  120  J=1.N0FET2 
R = 0.0 
KPTS  = 0 
no  no  K=KH,KE 
KH?  = GRO'JPS(K) 

KPTS  = KPTS  ♦ KFPPTS(KP2) 
no  R = R ♦ AVAR(.J.KB?)  * KEPPTS(KB2) 

120  AVAR(J.KPI)  = R / KPTS 
KEPPTS(KH1)=KPTS 
JJ  = 0 

NFW5UH  = SUGPTR(KRI) 

no  123  J1=1.N0FET2 

no  123  J2=1.J1  • 

JJ  = JJ  ♦ 1 

1?3  COVAR  ( JJfNEWSUB)  = (COVAR  ( JJ'NF.WSUB)  - ( AVAR  ( J1  »K01 ) * 
• AVAR( J2*KB\ ) ) *KPTS)  / (KPTS-i) 

12S  CONTTNUF 
C PEOUCE  ‘iEANS 

130  no  140  K=l.N05Ul?2 

IT  = SIHVC2(K) 

KPPPTS(K)  rKFPPTSd  I) 
no  l*fi  vi=l.N0FET2 
140  AVrN(J»K)  = AVAP(Jtll) 


RETl^RN 


REDOOBOO 

REOOOhlO 

RED00B2O 

PEO00«30 

REO00B40 

REDOORSO 

REOflOBbO 

PED00870 

REDOOB80 

REDOObRO 

RED00900 

RED00910 

RE000920 

REn00930 

RE000940 

Rt  0009S0 

RED00960 

RED00970 

RE000980 

WED00990 

REDO  1000 

REDOlOlO 

RED01020 

RE001030 

Rt001040 

RE001050 

RED01060 

RE001070 

REOnjOflO 

RE001090 

WEnOllOO 

REOOlllO 

RE00U20 

RE001130 

RED01140 

RF.D01  ISO 

REnOllbO 

REOOl 170 

REDOl IfiO 

RED01190 

RE001200 

HE001210 

REn01220 

RED01230 

Rf001240 

RED01250 

RfD01260 

RE001270 

REOOlSbO 

PED01290 

RED01300 

RED01310 

PE001320 

Rt001330 

RED01340 

RED01350 

HED01360 

RE 00 1370 

REDftl3fl0 

PE001390 

RE001400 

fiEOOmo 

REn01420 

REU01430 

RED01440 

RE001450 

RED01460 

RED01470 

RE00l4flO 

FLOO  l490 
PEnoison 
RtOOlSlO 


noon  o o r>or>  o or»oo 


FILFt  PEHSAV 


SEND 


100 


no 

10 


SUBROUTINE  PEOSAV ( ARRAY  * T0P»BHFL6) 

IMolICTT  INTFGEP  (a-Z) 

DIMENSION  ARRAY (1) 

INCLUDE  COMRKl.LIST 

INCLUDE  C0K9KA,LIST 

COMMON/ INFORM/NOtl,S?»NOSUP2*NOFET?.VAPS72»TOTVT?«NOFLO?. 

' AVAR2. CnvAR?,CLSID2«SUBN02. SURDS?. FL0SV2»VERTX2» 

' FtTVC2(30)  .SllMVCaCTS)  ,SUHPTH(7S)  .CLSVC2<60)  » 
KFPPTS(^O)  .NOr»RP.GKPNAM(60)  .6PPDEX(61)  ♦ 
fiPPCHK (61) .GROUPS (12A) 

COMMON/r,LOBAL/MFaD(63)  .MAPTaP.DATAPE.SAVTAP.RMFILE.BMKEY. 

HlsFIL.HlSKEY.TPFORM.fRlPTP.fRPKEY.MAPUNT.NOFlLE. 

nRUMflr).DPM*nS.RAGSIZ.DaTFIL.5TAFIL.ASAV.ASAVFL 

,NH«;TUN.N-'5TF'I»SCTRIIN.M4PFIL 

.DOTUf>lT,OOTFIL.NCHPaS.TRNSFL.BMTRFL.HlSTFL.PCHUNTf 
CPDUM  .PkTUNT.RaNDIO 


w 


0) 

CREATED! 


EXITING  FROM 


DIMENSION  FETVEC(30) 

PEWIMD  SaVTAP 

IF  (STaFIL  .KO.  -1)  WRITP(6. 

fopm4T(//  t=>.»stat  file  was  ‘ 

IF  (^TAFIL  .FO.  -1)  CALL  CMERR 
IF  (STAFIl  .FO.  0)  60  TO  10 
Cai.L  FSPSFL  (SavTAP.STAFIL.ISTAT) 

IF  (ISTaT  .F(j,  0)  GO  TO  10 
Ell. NO  r STaFIL  ♦ 1 
uptTf  (IS.  1 10)  FTLNO 
FO«MaT(//  T>:.*FPROR  IN  POSITIONING 
• EXITING  from  HEDSAV) 

rONTlNUF  - - 

RFaO(5avTaP)NOCLS,NOSUB.NOFEAT.NOFLD.TOTVRT, (FETVEC(I) . 1= 1 .NOFFAT ) RtOOOGSO 

RFD00360 

COMPUTE  PASFS 


stat  file  to  file  *.13. 


Rf POOOlO 
RF.000020 
PE000030 
RED00040 
PE000050 
REOOnONO 
PE000070 
PE000080 
PED00090 
REOOOlOO 
RFDOOllO 
PF000120 
PE000130 
PE000140 
PF000150 
PE000160 
PE000170 
PEDOOIBO 
RED00190 
PE000200 
RE000210 
Rt000220 
RE000230 
PE0002AO 
••REDSAV** • ) RE000250 
PE  000260 
PED00270 
PE0002B0 
PE000290 
Pt000300 
RED00310 
RED00320 
RED00330 
PED003AO 


VAOSIZ 

<-Lsmi 

SU°N01 

suansi 

FLriSVl 

VEPTXl 


N0FFAT«(N0FEAT*1>/2 

1 

■ NOCLS 

NOCLS 
NOSUB 
NOFLD*A 


CLSini 

SUPNOl 

SU=>DS1 

FLOSVI 


CALL  SaVFIL (ARRAY (FLDSYI ) . ARRAY (VERTX 1 ) .ARRAY (CLSIOl) . 

* ARRAY (SUBnOI) .array ( SUBOS 1) . NOFLO. NOCLS. NOSUB ) 

CALL  CLSCHO (ARRAY (CLSIOl ) . ARRAY (SUBOS 1 ) . ARRAY (FLDSVl ) . 

* aRRAY(VEWTX1 ) ,ARRAY(SUBN01) .nofeat.fetvec. 

* NOCLS, NOFLO. HMFLG.NOSUB) 


COMPUTE  REDUCED 


VARS/2 
CL'510? 
CliRNO? 
SURDS? 
FLUSV? 
vFRTy? 
CnVAR? 
AVAR?  = 


CALL  PEODAT 


kEL'00370 
SE.D00360 
RED003NO 
WEOOOAOO 
RfcOOOAlO 
REU00420 
PE000430 
RED00440 
RFDOOASO 
PE000460 
RE000470 
RED00460 
RF;000490 
REOOOSOO 
REOOOSIO 
PED00520 
«E(;OOS30 
MLOOOS40 
RED005S0 
RFD00S60 
REOO0570 
REOnoSftO 
WEOO0S90 
REU00600 
RF000610 
RfcD00620 
Rf 000630 
Rfcf’00640 
PE0006S0 
Rf0006h0 
REunoftTO 
REOO0660 

(ARRAY  (CO  VAR?)  , ARRAY  ( AVAP2)  . ARP  AY  ( CI.S  I 0 1 > . ARP  A Y ( SUPNO  ] ) RKOO  0690 


NOFET? 

1 

CLSIO? 

Su-SNOR 

SUiJOS? 

FLUSV? 

VFRTX2 

COvAR? 


OASES 
* (N0FET2 


1)  / 2 


♦ N0CLS2 

♦ NOCLS? 

♦ NOSUB? 

♦ N0FL0?*A 
» T0TVT2  • 2 

* VAWS7?  * N0SUB2 
C0V1  = nVAM?  « (NOFFAT*nOSUB  ) 
TJRTUP  = CjVI  ♦ VAWSI7 
RAOCnR  = TOP  - TIPTOP 
IF  (HaOCOR  .LT.  0)  GO  TO  SO 


«;n 

*.0 


an  Tn  70 
wwTTP (6.00) 


. ARRAY (SUPuSl ) . APRAY (FLUSVl » . ARRAY ( YFRTX 1 ) . 
ARRAY (COVl ) . APPAY ( AVAR?) . APR AY (CLSID?) • 
ARRAY (SURN07) . Array (SUHUS?) . array (FLDSV2) . 
ARRAY  (VfRTX?)  .nOFE  AT  . V APS  I Z .Nf'CLS  .NOFLU  . 
UOSUR.FFTVEC) 


mOFi-T?,N0SUH?.  NOCLS? 


FOR'^ATC  USFR  RE  '.LIFSTFU  ‘tl?.*  C^ANNFLS.  *.12. 

’.and  classes. •/•  This  comhinmiun  of  stats 


PEU007D0 

REDOfi?!  0 

W(  f'007?0 
Pf  000730 
RFi)00740 
pf  ono7so 
RFU00760 
Rfoofi  no 

• SUHCLAS*=FS.  '.rLOOOThO 
WILL  NOT  FIT  IN  PFOnOTNO 


•^9 


FILRl  REOSAV 


•CORF.  PLEASF  REDUCE  HEOUEST.*) 

REOOOROO 

CAUL  CMEHR 

RFU00610 

PE0006?0 

70  CONTINUE 

Rroooaao 

RETURN 

RF000840 

END 

REOOOeSO 

met  PREAO 


SUBROUTINE  RREA0(8E6A00*/WHERE/*T0TW0StSTATUS) 


C 

C 

C 


C 

C 


THIS  SUBROUTINE  SIMULATES  THE  HANSOM 
WOPKFlLE  USED  to  STOME  PftOfikAM 
LARSYS  PROCESSOR  RUN  ‘ 


ACCESS  READ  OF  A 

uaTa  temporarily  during  a 


THE  CALLING  ARGUMENTS  ARE: 


REGAOO  - 

WHFRF  - 
TOTvnS  - 
STATUS  - 


THE  NUMBER  OF  WORDS  FROM  ThE  BEGINNING  OF  THE  FILE 
MMFoe  tme  read  is  to  begin,  _ ^ 

WHFRE  The .DATA  READ  IS  TO  BE  PUT  (OUTPUT  AREA), 

thf  total  number  of  words  to  be  read.  „ 

SET  TO  ZERO  WHEN  I/O  IS  COMPLETE  (NO  LONGER  USED* 
BUT  MUST  BE  RETURNED  AS  0) . 


C 

C 

C 


C 

C 

C 

C 

C 


c 

c 

c 

c 


IMPLICIT  INTEGER  (A-Z) 

HANSEN  / VERSION  0800/B/3I/77 

DIMENSION  BliFFER(aoO)  .WHERE  (1) 

PUFS1Z*200 

BUFFER  AND  BUFSIZ  ARE  SET  TO  THE  MOST  EFFICIENT  SIZE  TO 
MATCH  THE  PHYSICAL  RECORD  SIZE  OF  THE  I/O  BUFFER.  In 
CMS  IT  IS  300  BYTES  - 200  WORDS, 

STATUSsO 

LUOa?2 

LUO  IS  THE  LOGICAL  UNIT  NUMBER  WHERE  THE  FORTRAN  DIRECT 
ACCESS  FILE  IS  STORED. 

j1=MOO (BE GADO. BUFSIZ) 

IF(Jl.FO.O)  Jl=riUFSlZ 

J1  IS  the  rflative  address  of  the  beginning  word  in  the 

■first  RECORD  TO  BE  READ.  IF  IT  IS  0.  IT  IS  THE  LAST  WORD 
IN  THE  RECORD. 


j^i?=RFGAnO 

J3=8EGA0D 


♦ TOTWOS  - 1 


?on 

2in 


J2  A^D  J3  A-5E  THE  BEGINNING  AND  ENDING  WORDS  OF  THE  DATA 
T.0  RE  READ. 

j4rH.-,r,(  J3.H1JFSI7) 

!F(.i*..FO.O)  J4=RUFSIZ 

JV,  IS  THE  relative  address  OF  THE  ENDING  WORD  IN  THE  FINAL 
RECORD  TO  HE  BEAD.  IE  IT  IS  0.  IT  IS  THE  LAST  WORD  IN 
THE  RECORD. 

REGREC=( (J2-l)/BOESIZ)  ♦ 1 
■FNnBFC=((J.J-l)/Pi'FSIZ)  ♦ 1 
lEiBEGPEC.ED.ENDHEC)  GOTO  300 

PEGPEC  AND  ENOREC  ARE  THE  RELATIVE  ADDRESSES  (RECORD 
NLimbERB)  of  the  first  and  LAST  RECORDS  TO  BE  READ.  IF 
THEY  are  EoUAL  THEN  WE  ARE  TO  BEGIN  AND  END  IN  THE 
SAME  RECORD, 

KIsRFGREC 

PFAO  THE  FIRST  RECORD  AND  MOVE  THE  REQUIRED  PORTION  TO 
THF  OUTPUT  AREA. 

RFAD(Llin*AH  BUFFER 
no  ?no  K2SJ1.HUFSIZ 
WHFRE  (IDsHUFFFRIKZ) 

I1=I1*1 

CONTINUE 

K1=K1.1 


Of  AO  IN  The  NF»T  RECORD.  .....  _ _ . _ 

BE  0F4D.  GO  TO  The  FINAL  RECORD  MOVE  CODE  ELSE  MOVE  THE 


IF  IT  IS  the  FINAL  RECORD  TO 

IRO  ■ ■ 

entire'  RECORD  TO  ThE  OUTPUT  AREA, 

IF(K1.F0,FNDRKC1  ROTO  230 


RREOOOIO 

RRE00020 

RREOaOSO 

PRE00040 

RREOOOSO 

RRF00060 

RRE00070 

RREOOOBO 

PPE00090 

RREOOjOO 

PPEOOnO 

PREOOI20 

RRE00I3O 

RREOOIAO 

RRE00150 

RRE00160 

RPE00170 

RPEOOIBO 

RRE00190 

RRE00200 

RPE00210 

RRE00220 

RPF.0H23O 

RRE00240 

fiPEnogso 

RRF.00260 

PRE00270 

rrNo2bo 

RRE00290 
RRE00300 
RPE00310 
RRE00320 
RRE00330 
RRF.00340 
RRE003S0 
RRE00360 
RRF.00370 
PRE00360 
PRE00390 
PRE00400 
RPE00410 
RHE00420 
PPE00430 
RPE00440 
RPE00450 
RRE00460 
RRE00470 
RRE004RO 
RRE00490 
RRE00500 
RPFOOSIO 
RPE0OS2O 
RRF.00530 
RRE00S40 
PRE005S0 
RPE005SO 
PPE00S7O 
RPEO0S8O 
RPF00S90 
PRE00600 
RRF00610 
RRE00620 
PREO0G30 
RRF00fe40 
RPE006S0 
PREOOfeGO 
RRE 00670 
PHE006BO 
PPEO06R0 
HRF  00700 
RRE 00710 
RRE  (10720 
HRE 00730 
oRF.00740 
PRt007S0 
RRE00760 
RRFO0770 
PRF0O7B0 
PRL00790 


rioooo  onr»o 


riLFi  RRCAO 


230 


240 


300 


310 


MOVE  The  required  portion  to  the 


RE«oaunmn  buffer 
no  220  K2«l.RitPSIZ 
whFHC(I1)>hUFFER( -21 

ciwHNUE 

BOTO  210 

READ  THE  FINAL  RECORD. 

OUTPUT  AREA  4N»0  RETURN 

BF»rMUiD'Kl)  PUFFER 
no  2*0  K2»l,04  _ • 

whERF(I1)»HUFFER(K2) 

ii»n»i 

CONTINUE 

RETURN 

HERE  -JF  BEGIN  aNQ  END  IN  THE  SAME  RECORD*  THEREFORE  VE  , 
ONI  Y MOVE  the  required  portion  OF  THE  DATA  TO  THE  OUTPUT 
AREA  AND  RETURN. 

OEAOILUO'BEfiOEC)  BUFFER 
no  310  K2XJ1.J4 
WHERE  (II  )*HIIFFER(K2) 

ii  = n*i 

continue 

RETURN 

END 


PREOOBOO 

RRE00810 

RPE00S20 

RREO0P30 

RREO0H40 

RREOOdSO 


RREOOaSO 
RHEOOeRO 
PRE0090Q 
HREOOOiO 
RPE00920 
RRE00930 
RPE00940 
RRE009SO 
RPE009(S0 
RRE00970 
RRE009B0 
BPE00990 
PHEOIOOO 
RPFOiOlO 
RRE01020 
PPE01030 
RPE 01040 
HRE01050 
PRE01060 
RRE01070 


r»nr»  ortno.-^rt  r»r>r»or>r»  nctonn  r»or»o  ortooo  rtrtrirt"  no'ooo.  nr»o  rK^r»r»nr»r»r»r»f»r>r»r»r»r» 


PILF*  RWRITE 


SUBROUTINE  RWRITE(8E6AOU«/WHERE/*TOTWDS*ST*TUS) 


THIS  SUBROUTINE  SIMULATES  THE  RANDOM  ACCESS  WRITE  OF  A 
WORXFILF  USFf)  TO  STORE  HROGRAM  DATA  TEMPORARILY  DURING 
A LARSYS  PROCESSOR  RUN.  THE  CALLING  ARGUMENTS  AREJ 


REGADD  - 
WHEPF,  - 


totwds  - 

STATUS  - 


THE  numhfh  of  words  F«0M  ThE  reginning  of  the 

FILE  WHERE  THE  WRITE  IS  TO  BEGIN, 

where  the  data  TO  BE  WRITTEN  IS  STORED  (INPUT 

AREA)  . 

THE  total  number  of  WORDS  TO  RE  WRITTEN, 

SET  TO  ZERO  wmEN  I/O  IS  COMPLETE  (NO  LONGER 
USED,  RUT  must  BE  RETURNED  AS  0) 


implicit  integer  (A-2) 


HANSEN  / VERSION  0800/8/31/7T 


dimension  tiUFFEK  (200)  .where  (U 
PUFSIZsZOO 


PUFFER  AND  PIIFSIZ  ARE  SET  TO  THE  MOST  EFFICIENT  SIZE  TO 
match  the  physical  record  size  of  the  I/O  BUFFER.  IN 
CMS  IT  IS  800  BYTES  - 200  WORDS. 


STATUShO 

LUO=?2 


LUD  is  the  LOGICAL  UNIT  NUMBER  WHERE  THE  FORTRAN  DIRECT 

access  file  is  stored. 


jj=MDr)(ME6AD0.flUFSIZ) 
IF(Jl.E'j.O)  J1=BUFSIZ 


J1  IS  The  relative  ADDRESS  OF  THE  BEGINNING  WORD  IN  THE 
FIRST  RECORD  TO  h-F  wRITTF.N,  IF  -IT  IS  0.  IT  IS  THE  LAST 
WORD  IN  THE  RECORD. 


j?=PFr,AOO 

J3=BEGAOD  ♦ TOTWDS  1 

J?  AND  J3  A^E  THE  beginning  AND  ENDING  WORDS  OF  THE  DATA 
T(5  6E  WHITTEN. 


J4smOO(J3.PUFSIZ) 
IF(J4.F(0,0)  J4»PUFSIZ 


J4  IS  The  relative  address 

FINAL  RECORD  TO  RE  WRITTEN 
LAST  WORD  IN  THE  RECORD. 


OF  THE  ENDING  WORD  IN  THE 
IF  IT  IS  0.  IT  IS  the 


RFGORC»(  (J2-n/'iURSIZ)  ♦ 1 
FNDhE  C=(  (J3-l)/R'iFSIZ)  * 1 
TF (HFGREC.EO.fc'NDREC)  GOTO  300 

PEGRRC  AND  FNDpEC  ARE  THE  RELATIVE  ADDRESSES  (RECORD 
N(jHPpPS)  OF  ThF  first  and  last  RECORDS  TO  PE  WRITTEN, 
IF  THCV  ARE  FOUaL.  then  WE  ARE  TO  BEGIN  AND  §NO  T.N 
THF  SAVE  RECORD. 


KlaPFGREC 


READ  THE  FIRST  RECORD  (THFRF  MIGHT  BE  DATA  IN  THE  PORTION 
OF  THF  RECORD  WF  ARE  NOT  WRITING).  MOVE  IMF  •MEOUIRt'f’ 
PORTION  OF  Thf  data  From  the  input  area  to  The  dUFFER 
AND  WRITE  IT  OUT. 


/ READ  (LUO'Kl ) f'FFER 
no  ?no  K2*Jl •“UFSIZ 
PUFFER  (S2)=HHF“t  (ID 
Tl*n*l 
?nO  CONTINUE 

V'RTTF.  (LOO*KD  “UFFtR 


Plfip  trR  wecORD  counter  and  CHECK  TO  SEE  WHETHER  wE 
ABF  AT  ThF  final  RF.CORO  TO  BE  WRITTEN.  IF  WF  ARC,  GO 


RREOOOlO 
RRE00020 
RPE00030 
RRL00040 
RRE00050 
RRE00060 
RPE00070 
RREOOOBO 
RPEOQ090 
RREOOinO 
PREOOilO 
RRFOOiZO 
RPE00130 
RRF00140 
RREOOiSO 
PPCG0160 
RRE00170 
RRF.00180 
RRf OOlPO 
RRE00200 
RRE00210 
RRE 00220 
RRE00230 
RRE 00240 
RRE00250 
RRE00260 
RRE00270 
RRE00280 
RRF00290 
RRF00300 
WRF.00310 
RRL00320 
RPfc00330 
RHE00340 
PRF003S0 
RRE003‘^0 
RRF00370 
RRE003B0 
RPE00390 
HRF.00400 
WKE004l0 
PRF00420 
RRF00430 
RRE  00440 
RRE 00450 
RRE00460 
RRtf)0470 
RRF.004ftO 
RRE00490 
RRL00500 
PRE00510 
PRE00S20 
RRE00530 
RRE 00540 
RPE00550 
RRE00560 
RRK00570 
RREOOSPO 
RREOOSRO 
PPF00600 
PRtOOMO 
RR600620 
RRU1&630 
RRF  00640 
RRE00650 
BwFPOhOO 
WRF00670 
RRF  006RO 


RP) 00fc90 
RPO  0 0 700 
HRF0071 0 
RBf00720 
RRF.  00710 
F'Rf  00740 
BRE007S0 
RRE  00760 
RRl 00770 
RR( O07H0 
RRt00790 


9^SJJ 


noooo  onr»r»o 


riLPJ  PWPITf 


? 


?20 


TO  TH^  final  PFCOPO  wRITE  CODE  ELS€  MOVE  AND  WRITE 
THF  ENTIRE  PECOMO. 

I^*Klt^O.ENnpEC>  GOTO  230 
nn  220  '<2«1.«»UFSIZ 
PUFFEPCr2)«4MEPE<U) 

rONTlNUE 

WRITE  (LU0»K1»  PUFFEJ» 

GOTO  210 

READ  the  final  RECORD*  MOVE  THE  REQUIRED  PORTION  OF  THE 
DATA  FPO**  THE  INPUT  AREA  TO  THE  BUFFER*  WRITE  IT  OUT 
AND  RETURN. 


230  PEADCLUD'aI)  buffer 
00  240  K2xl»J4 

puffer  (k2)«WHERE  (ID 
11=11*1 
?40  CONTINUE 

WRITE  (LUO »KD  PUFFER 
RETURN 

ssr?  5&!SfD'SoJ?foS‘Sf 

input  area  TO  The  BUFFER*  WRITE  IT  OUT  AND  RETURN. 

300  PFACHLUD'BEGhEO  BUFFER 
no  31 n K2=J1.J4 
oi|PFFE('<2l*W‘iERE(n» 

11=11*1 
310  CoNTIN'jr 

WRITE  (LUO'iiFRREC)  BUFFER 

WFTUHN 

FN(T 


RREOOROO 
RREOOBIO 
RRE00B20 
RRE05630 
RREOOMAO 
RRE008SO 
RREOOfUSO 
RRE00670 
RREOOBOO 
RREOObRO 
RREOOROO 
RRE0091Q 
RRFO0920 
PRFOOV30 
PRE00940 
RRE009S0 
RREoovno 
RRE00970 
PRF009P0 
RRE00990 
PREOIOOO 
RRt 01010 
PRE01020 
RRE0l030 
pREOiOAU 

rreoIoso 

PRE01060 
RRT01070 
RRE01080 
RRE01090 
PREOljOO 
HREOiilO 
RRE01120 
PhEOI 130 
PREOl 140 
RREOl 150 


[ 

FILPl 

C 

? 

C5FND 

c 


1 


4 


?AVFIL  I 


SUWPOUTInE  SAVFlL<FLPSAV»VFt.TEXfCLSI0.SUHN0.SU80ESf 
» NOFLO«NOCLS«NOSU8) 

implicit  InTFisfr  (a-2) 
tNCLUOF  COMMKl.LlST 
INruir>f  COM^K^»CisT 

COMMON/ lNF0OM/N0CI.S?«N0SUn?.K0FeT?»V»BS??.T0TVT?.N0FL02* 

AVAM>».cnVAM?.CLS102»SUHNO2.SUBnS?.FLn5V?»VEf»TX2» 
FKTV^POO)  fSUMVC2(75)  ,SUBPTK<?5)  .CLSVC2<60)« 
i<ePPTS(60)  *N0rfRPt6HPN*M(b0)  tOPPOEXibl)  • 

. RM(-CHK(A1)  »GPOgPS(12*) 

C0MM0N/GL0riAL/H|4tM63) *n*PTAP.nAt*PE.5AVTAP»BMFILE»HHKtY. 

MlSML«Hl<lKt  YtT«FORM,£P|PTP»EPPKFY»MAMUNT»NOF 
pailMft[i*n»MvuStPA6SI2»nATFIL»STAFlL*A5AV»  ASAVFL 
.MmSTuN.NHSTFI tSCTMUN.MAPPiL 

.noTUfJT.ontf IL,NCMPAS.T»NSFL.BHTPFL»HlSTFCtPCHUNT* 


ILF.t 


CMDUNT 


TUNTfMnNOIO 


n I MENS  TON  Fl  0S»V<4»N0FL0)  fVEPTEXU)  »CLSID(1)  *SUSNOn)  » 
SufluESTl) 

TP*0 

no  An  jal.NOFLD 

OEA0(SA*fTAP|  (FLDSAV(ItJ)  *1*1. A) 

FLO  s ? * FLrjS4vU«J) 
oFAO(«^avTAP>  (vEf-TEXC  I*I8)  .I«1»FL0> 

TP  2 ♦ FLO 

rooTTNMF 

OEAD(SAVTAP)  (CLSinC  ) »I«1  .N0CL5>  » ISUPNO  «I ) . I»1  tNOCLS)  t 
(SUPPtS(  I)  »I»ltNOSUe») 

OETUPN 

ENO 


SAvnoolO 
SAV00020 
f AV00030 
SAVOOOAO 
SAVOOOSO 
SAV00060 
COHOOOIO 
CO*'000?0 
COH00030 
roHoooAO 
COM00050 
CUMOOOlO 
COM00020 
COM00030 
COMOOOAO 

coMnooso 
COM00060 
SAVOOOBU 
SAVOOOVO 
SAVOOlOO 
SAvoono 
SAVOOlPO 
SAV00130 
SAvooi AO 
SAV00I50 

savooIno 

SAvno j 70 
SAV00190 
SAV00190 
SAV002DO 
$AVOO?10 
SAV00220 


-^jry 


SE»RCM 


c* 

f« 

c* 


SUOkOUT  I -;K  * bCh  « • t • . ENOT  *P  ♦ 1 PUE  • NHPfIS  * NOSPR » 

implicit  integer  (*"2> 

INTEPN4L  MOllTlNE  TO  Sf*«CH  FOR  CORRECT  SCAN  LINE 


10«1' 

ri^Ff 


6I« 


SFAOOOlO 
8FA00020 
SEA 000. TO 
SFA00040 
SFAOOOSO 

CAL*I  LSC*N(*»»ISCAN«*>.KSCAN(A)  HfS225S 

ri'^FNSlnN  1 4nF  I7^S)  ,KnuM<n  ,LOUM|j)  STA00070 

COMMON  /t4R»PD/  IilNlT,lFMST.FSCAN,SAMENO.SAMlNC»Mt AOr.NSCAN.  ^^*22222 

• I INC.  I0(?00)  .OSLfl.RitF  <30)  *JKtC«30»  ♦IHYTE  (30>  ♦NHUFtFlLEN0.LlNEN0.5f  AOOORO 

• L INIi.C.NSAmp.noChan.FOBMT  _ 5EA00100 

fouIvaLFnCE  ( I SC  AN.  SCAN! . (kOUM  < 1»  .FSCAN(  1 ) ) . <LOUMU»  .LSCANi  1 ))  S|  *00119 

SCANan 

WOTTF  t(S.6nO>FSC*N 
r0OM4T».  SE&PCHiNr,  FOR  LINE*. IS) 

WP1TF  (N,M0)NRi»ns.ND5PH 

FOB**aTM  records  PFH  SCAN».I5.*  SCANS  PfB  RECORD*. IS) 

TP*0'  = -S 


IF  »*‘RMDS,r,T,S)  IRACF»“N«POS 
TF (f srAN.LE.S) IHACN«-NRPOS 
«-I8ACK 

no  I»1.PSKIP 

A70  paCkSMaCE  I'iMT 

T1«Y*1 

e,  OFAonii‘ilT.QlP.EN0s630) 

«JI  n FOR^'aT  ( 1 »•  a*  ) 

r-o  Tfi  ‘'<.0 

630  FNOTAP  s -1 

bFTuRn  1 
6AO  rONTlNilK 

KOhm  [ 1 ) sf.tuF  ( 1 1 
i nuMM  ) =1‘-UF  ( !•) 


) n 
700 

IS 

70 

«on 

30 

ooo 


(IRUFd)  .I-l.lS) 


IF 

(F  OF 

.Fi). 

1 ) 

ISCANT3) 

m 

IF 

(FMO'-iT 

.FO. 

)) 

ISCAN(a) 

s 

IF 

(Fi)U'.  T 

.F'O. 

;*) 

ISCANO) 

B 

If 

(Fr>P''T 

. ► 'J  t 

?) 

ISCANTA) 

r 

wPTTf  (*-.*) 

-d  ( SC  Al. 

"AIT* 

Sf  AN 

NO* 

. 1S.3X) 

LSCANO) 
LSC*N(A) 
NSCAN( 1) 
0SCAN(7) 


TFCS'^A'-.f^  •*''CAf')(?0  TO  10 
TF  (STf'  .ro,F<;c.iN..'j0SPR)60  TO  30 
TFT  I TWy.s-  ■J.IT'ICO  1u  70 
font  II 

tTBY=IT!7y.l 
F,o  in  s 

-3TTi-‘  (*-.7  00)  TTRY 

FORMAT!*  FOUNT)  IT  AFTER*. 13.*  TRIES*/)  . 
no  l-^-  I I 2]  .r  opf,*, 
o A"*  ' ' ACF  l()l ' I T 
prill'-'. 

IF  ( n*- Y,l.T.?*MRHi)S)GO  TO  6 
YW  I TT  ( ». , - All  I I T T Y 

f-OOM<u(.  failFii  aFTFH'.IS.*  TRIES— aROWTING*  ) 

CAI.I  C**)  mk 

roMIlJii' 

FO"^'on  •'^sr  AN^.  15.  • IS  MISSING— USING  previous  scan  instead*) 

MAfKV)-  Al't  I U*.'I  T 
PFTU**'!  .•* 

FNn 


5EA00170 
Sf A00130 
SEAOOlAO 
5EA001S0 
5FA00160 
SF A00170 
SEAOOlOO 
SFaDOIRO 

sEaoopoo 

SE A00210 
SFA00770 
SF A00730 
Sf aoo|ao 
5EA002S0 
SEA00260 
SE A00270 
SEA002A0 
Sf A002R0 
if A00300 
Sf A00310 
se aoo3?o 
Si A00330 
SEAO03AO 
Sf A003SO 
Si Ano3NO 
SF  A00370 
SF  A003«0 
SI  a003'J0 
Sf  A00*.00 
sf AOOAlO 
St  Aon<*20 
Sf  A00A30 
SE A00A40 
SF.  AOOASO 
SF  Ano**NO 
SE  AOO*.  70 
SE  AOOamO 

seaooaro 

Nt  AUOSOO 
SE AOOSIO 
Sf  A00S7U 
SE A0CS3O 
Sf  AOOSAd 
SE  AOObSO 
SE A00S60 
Sf A00S70 
SE AD0S80 


Flip:  SETMPG 


«;UP®.OUTINP  PETVBGlA.fitC) 
IMOLICIT  INTEGER  (A-C) 
return 
ENn 


SETOOOlO 

SET00020 

SET00030 

SETOOOaO 


page  is 
.jJx  QUA  PITY 


FILE*  SETUP? 


SUBROUTINF  Sf 
IMPLICIT  INTI 


TUP7(ARPAY«TOP»ITImE) 
Gfc'P  (A-XJ 


SETOOO] 

SETOOOi 


SETUP?  REARS  AND  ANALYZES  ALL  CONTROL  CARO  INPUT  FOR  THE 
ISOCLS  PROCESSOR 

COMBKA.LIST 
comsks.lIst 

COMHKA.LIST 
Cmbk16»L1ST 


•NSlON  HFOl  (15)  .ME02(15»  .DATEO)  tCOMENTUS) 

" (HEDl(l).MEADU)).(04TE(l)tHEA0(22n* 


:«END 


.NCLUOE 
INCLUDE 
INCLUDE 
0IME^ 

EOUIVALENCE  - _ _ - - 

2 (HED2(1)  .HEAD(.IO) ) » (COMENT  (1  > »HEAO (48)  > 

COMMON/PASS/STOP. LNCAT.NMINtKPN.STOMAXtDLMlNt SEP* 

* map.sptrig,  iko.  kpts*  nopts*  punch, 

♦ 1CHN»CHNTMS,ICHAIN{62) ,MWDS, IBtGlN.BEGlNl » 

• 9EG1N2. BEGINS, CLSNAM,M0FL0»IPT,T07wftrj.T0TPTS* 

* NCLASS,NOCL5»TOTSUB,TOTFLO»TOTVRT,NOCL*NVRT 

* ,NXTCLS,NOFFAT,M4XCLS,FFTVFC(30) »SYMMTX<62) 
*,VARS!7,STATKY,ISOKFY»MAPFMT,mAPKEY.SEOUEN(20) ,percen,simerp 
•»I0PnER»lNUNlT,Ii'FlLE,lNITH,PMlN,BUBVEC(62) ,N0SUB2,CHNVC(30) 

• .NOCH AN, FRC0“P,NGSE0, HE ANOO, ME 4NOU, 

• • SYMOn,SYMi)il,  ITRIGO,  ITRIGU«OOFLAG» 

* DUFLAG,nOl)U,STDOTS(GO)  »NSDOTS,SUNCOR(30)  tLLNCAT* 

* OVERT  (250, ;•)  ,OPECT  (60,2)  tOVPNT  ( 1 1 ,2)  , IDCNT  (2)  ,N00U(2) 

• ,MXFET1 ,MAXPOP 
REAL  suncor 

C0MM0N/f5L0B4L/HEAD(63)  ,MAPTAP,I)ATAPE,SAVTAP,BMFILE,PmKEY, 

HISF1l,HISKEY,TRF0MM,ERIPTP,ERPKEY,MAPUNT, nofile* 
DRUMAn,DRHWDS,PAGSIZ,DATFIL,STAF!L*ASAV,ASAVFL 
,NHSTUN.NHSTFI ,SCTPUN,MAPFIL 

,D0TUNT.n0TFlL»NCHPAS,TRNSFL»8MTRFL»MISTFL>«»CHUNT* 
CRDUNT,PPTUNT,PAN0I0 
COHMON/ISOLNK/SUNANG(tt) ,ISUNT»ISUNC»SMSTR,SMSTP,SMINC,LINSKP 


REAL  nLMIN,CHNTHS,SEP,STDMAX,PERCEN 
DIMENSION  ARRAY(l) ,CHAR(2) 

DIMENSION  C0MVEC(2) ,EQUVEC(2) 

DATA  CnMVFC/l,',»/,EOUVEC/l*»»»/ 

DATA  MINUS/*-'/ 

EOJI valence (STOP, I STOP) 

DIMENSION  INVECOO)  ,CAR0(62)  ,ACA»0(20)  ,SLASH(2) 
data  Sl.ASH/1,*/*/ 


DATA  INVFC  /'CHAN*, 
’SEP 


• ISTO* , 
•HEOl*, 


•NMIN* , 
•HEO?', 


•KWN  *, 

•DATE*, 


•STOM*, 

••END*, 


'SYMB',  'MEAN',  'MAP  *,  'OPTI*,  *CLAS*»  'CHAI*, 


•OLMI», 

•COMM** 


•FORM* , 
•SUtfC  , 


•DATA*, 

•PMlN't 


•STAT', 

•DOTF*, 


•SEOU', 
•SUNA*  * 


•PERC*  « 
•DOTS*/ 


•ruis* , 

•MOOU* , 

DIMENSION  SMBLS(bO) 

DATA  IBCn/'l •/,UBCD/'U'/,LBCD/*L»/»MaCD/*M*/ 

CHAP/1. •=•/,  EOUAL/'s*/ 

PPCn/*P'/,FBCn/*E'/»0BCD/»0*/ 

FBCO/'F*/,CBCO/'C'/ 

THC0/'T'/,SBCa/*S'/,OBCD/*0»/, blank/'  '/.COMMA/ • , • / 

SMBLS  /'I'.'Z'.'S'.'P'.'S'.'b'.'T'.'S'.'Y'.'A'.'B'.'C'.'D', 
•F','F','G','H','I',*J','  ,*L'»'M',»N','0',*P*,'0*, 

•R','S','T','U','V','W','X','Y',»Z','  ',' I ',•-•,•/', 
til,.  Is',, O','  •,'s',**i,')','(','|t. 


DATA 

DATA 

DATA 

DATA 

DATA 


*^*,'>','«','?*,1H'( 


8: 

c» 


IFdTlME.NE.DGO  TO  5 

SET  UP  DEFAULT  VALUES  FOR  INPUT  PARAMETERS 

EPCOMPrO 
lOPDERsO 
NOSEO  = 2 
NOCHAN  = 0 
SEP«1 
N0SUB2«0 
PMIN=1 
INITMsO 
MAPKEY=1 
MAPFMT  X 0 
ICNT=0 
PlINCHxn 
DLMINX3.2 


• / 


SET00060 
SETOOOTO 
SET00080 
SET00090 
SETOOlOO 
SETOOilO 
SET00I20 
SET00130 
SET00140 
SETOOISO 
SFT00160 
SET00I70 
SETOOiaO 
SET00I90 
SET00200 
SET00210 
S£Te0220 
SET00230 
SET00240 
SET00250 
SET00260 
5ET00270 
SET002B0 
SET00290 
SET00300 
SET00310 
SgY00320 
SET00330 
SET00340 
SET00350 
SET00360 
*Sf7003?0 
SET003B0 
SET00390 
SCT00400 
SET004J0 
SET 00420 
SET00430 
SET00440 
SET00450 
SET00460 
SET00470 
SET00480 
SET00490 
SET00500 
SETOOSIO 
SET00520 
SET00530 
SET00540 
SET005SO 
SET00560 
SET00570 
SET00580 
SET00590 
SET00600 
SET00610 
SET00620 
SET00630 
SET00640 
SFT00650 
SET00660 
SEI00670 
SET00680 
SET00690 
SET00700 
SFT00710 
SFT00720 
SET00730 
SET00740 
SET007SO 
SFT00760 
SET00770 
SFT00780 
SET00790- 


FILE!  SETUP7 


60 

.2 


2 

3 


STOMAX*6.S 
MAP«20 
STATKV-O 
fSTdPjlO 
NMIN«30 
KRN«20 
NCLASS»l 
HAXCLS  ■ 

ICHN»0 
PEPCEN  » 

IPCT  ■ 80 
isUNCsO 
ISUNT=0 
NSD0TS«0 
00  1 Isltf^AXPOP 
SYMMTX(t)  » SHBLSm 
N0FEA7  s 0 
ISTART  =0 

SEOUEN(I»ssAC0 
DO  3 I»2.1fl»2 

SEOUEN(I)=CflCO 
SF0UEN(20)*0 
CONTfNUE 

IFdTIME.K'E.n  WRITE(6«HEA0» 

WRITE(6*630) 

PUT  THE  NEXT  CARO  IN  THE  REREAD  BUFFE»i?/f;p,  ,, 

OF 


RRUNIT=30 

10  READ (?1« loon) (ACAROCI) *I»1*20> 

1000  FORMAT (20AA) 

WRITE (PPUNIT* 1000) (ACARO(I) tl«l*20) 
REWIND  HRtJNIT 


quality 


READ  IN  CARD 

RFADOO.AflO)  CODEtCARD 
REWIND  RRUNIT 
WRITE  (^♦S'iO)  CODE»CARO 
COL  * 0 
DO  20  T=1 ,30 

IF{CODE.£O.INVEC(in  GO  TO 
•(30 ,50,70,^0,90, 100,1 10, 130,1 AO, ISO *280, 160* 

♦ 170,250, 21 0,240, 200, 235,230, 220, 260, 270,246,249, 

* 256, 283, 284,300, 340, 380), I 
20  CONTINUE 

WRITE (6,490)  CODE, CARD 
GO  TO  10 


30 


35 


36 
645 

37 


43 


i? 


# 

.# 


V* 

8 


so 


CHANNEL  CARD 
JsNXTCHW (CARD, COL) 

YF(J,E0. BLANK)  GO  TO  ^ 

IF(ITIME.ro,l)  GO  TO  35 
WR1TF(6,640) 

GO  TO  10 
CONTINUE 

IE( J,EO,SBCD)  GO  TO  37 
IF(J,EO.O«CO)  GO  TO  43 
WRITE (6,645) 

FORMAT (•  ERROR  ON  CHANNEL  CARO*) 

GO  TO  10 

M=FIND12(CARO,COL,EOUVEC) 

IF (M,EO.-1 ) GO  TO  36 
N0CHAN=NUMBEP (CARO, COL, CHNVC,N0CHAN) 

COL  * COL-1 

CALL  ORDER (CHNVC, NOCHAN) 

GO  TO  30 

MaFIND12(CAPD,COL,EOUVEC) 

IF  (M  ,E0.  -1)  GO  TO  36 

NOFEAT  = NUM0EP(CARO,COL,FETVEC, NOFEAT) 

COL  = COL  - 1 

CALL  ORDER (EETVEC,N0FE AT) 

GO  TO  30 

ISTOP  CARO  (MAXIMUM  NUMBER  OF  ITERATIONS) 

J s NXTCHP  (CARO, COL) 

IF  (J,EO, BLANK)  GO  TO  10 


SET00800 

SET00810 

SET00820 

SET00830 

SET00840 

SET00850 

$ET00860 

SET00870 

SET00880 

SET00890 

.SET00900 

SET00910 

SET00920 

SET00930 

SET00960 
SET00970 
SET00980 
SET00990 
SETOIOOO 
SETOloio 
SET0i020 
SET0i030 
SET01040 
SET01050 
SET01060 
SET01070 
SETO1O0O 
SET01090 
SETOII 
SETOi; 
3ET01 
SETOll 
SET01140 
SETOllSO 
SET01160 
SET01170 
SET01180 


■TOl 


90 


sIto|2oo 

SE701210 
SET01220 
SET01230 
SET01240 
SET01250 
SET01260 
SET01270 
SET01280 
SET01290 
SET01300 
SET013iO 
SET01320 
SET01330 
SET01340 
SET01350 
SET01360 
SET01370 
SET01380 
SET0i390 
SET01400 
SET01410 
SET01420 
SET0i430 
SET01440 
SFT01450 
SET01460 
SET01470 
5ET01480 
SET01490 
SF.701500 
SET01510 
SET01520 
SFT01530 
SET01540 
SETOI 550 
SET01560 
SET01570 
SET01580 


FILEt  SETUP? 


COL-COL- 1 


NUMBER ( CARO  * COL  * I ST  OP • I ST  ART  I 


c» 


70 


C« 

C« 

C« 


GO  TO  10 

NMIN  CARD  {MINIMUM  NUMBER  OF  POINTS  PER  CLUSTER) 

J « NXTCHR(CARO.COL)^ 

IF  (J.EO. BLANK)  GO  TO  10 
COL  - COL -I 

J > NUMBER (CARDtCOLvNMIN  » 1ST ART) 

GO  TO  10 

KRN  CARD  (NUMBER  OF  ITERATIONS  PER  FULL  OUTPUT) 


■TO 1590 
’T01600 


g: 

c* 


c* 

c» 

c* 


c* 

c* 

c» 


c* 

c* 

c» 


c* 

* 


c* 

c* 

c* 


c* 

8: 


s: 

c* 


so  J « NXTCHR(CAPOtCOL) 

IF  (J.EO. BLANK)  00  TO  10 
COL  = COL-1 

J 3 number (CABOtCOLtKRN  * 1ST ART) 

GO  TO  10 

STDMAX  CARO  (MAXIMUM  STANDARD  DEVIATION  PER  CLUSTER) 

90  J = FLTNUM(CA»0«COL»ST0MAX.l) 

GO  TO  10 

DLMIN  CARO  (MINIMUM  DISTANCE  BETWEEN  CLUSTER  MEANS) 

100  J - rLTNUV(CARO«COL*OLMIN«l) 

GO  TO  10 

SEP  CARD  (DISTANCE  FOR  SPLITTING) 

no  J = FLTNUM(CAPDtCOL»SEP»l) 

SPTRIG»l 
GO  TO  10 

HEOl  CARO 

130  READ  (30»500)HE01 
REWIND  RRUNIT 
GO  TO  10 

HE02.CAR0 

190  READ  (3O.S0O)HED2 
REWIND  RRUNIT 
GO  TO  10 

DATE  CARO 

150  RFAO«30,510)  DATE 
REWIND  RRUNIT 
GO  TO  10 

COMMENT  CARO 

160  REAO(30.500)COMENT 
REWIND  RRUNIT 
GO  TO  10 

SYMBOLS  CARO 

170  CONTINUE 
180  YcNT*ICnT  ♦ 1 

IF  (ICNT.GT.MAXPOP)  GO  TO  10 
SYMMTX (ICNT) =BLANK 
190  MsNXTCHW(CAMD.COL) 

IF  (M.EU. BLANK)  GO  TO  10 
IF (M.FO. COMMA)  GO  TO  180 
SYMMTX (ICNT)  s M 
195  MsNXTCHR (CARD, COL) 

IF(m.fo.hlank)go  to  10 

!r(M.NF. COMMA)  60  TO  195 
GO  TO  180 

MAXCLASS  CARO  (NO.  CLASSES  FOR  THIS  EXECUTION  OF  ISOCi  S-  STATIST 
FILE  WILL  8F  WRITTEN  AFTER  'NCLASS'  CLASSES  HAVE 
BEEN  CLUSTERED) 


SET0168I 
SET01690 
SET01700 
SETOiTlO 
SET01720 
SET01730 
SETof  790 
SET01750 
SET01760 
SET01770 
SETOITBO 
SET0I79O 
SET01800 
SET01810 
SET01820 
SET01830 
SFT01890 
SET01850 
SET01860 
S^T01870 
SET01880 
SET01890 
SET01900 
SETOI910 
SET01920 
SET01930 
SET01990 
SET01950 
SET 01960 
SET01970 
SET01980 
SET01990 
SET02000 
SET02010 
SET02020 
SET02030 
SET02090 
SET02050 
SET02060 
SET02070 
SET02080 
SET02090 
SET02100 
SET0211Q 
SET02120 
SET02130 
SET02190 
SET02150 
SET02160 
SET02170 
SFT02180 
SET02190 
SFT02200 
SET02210 
SET02220 
SET02230 
SET02290 
SET02250 
SFT02260 
SET02270 
SET02280 
SET02290 
SETO23O0 
SET02310 
5ET02320 
SET02330 
ICSET02390 
SET02350 
SET0P360 
SET02J70 


riLEl  SETUP? 


200 

205 


C* 

S: 


C« 

p: 


c* 

c» 


c* 

c« 

c* 


c* 

c* 


235 


C 

s 


c 

c 

c 


241 


C* 

C* 

C* 


242 


245 


GO  TO  205 


MRlTE(4t650) 


GO  TO  10 

g«NyMBfR(CAPO«COL«NCLA$S*ISTART) 


40  TO  10 

HAP  CARD 


(NUMBER  OF  ITERATIONS  TO  OUTPUT  MAP) 


210 


J»NXTCHR (CAPO. COL) 

IF  (J.EO. BLANK)  60  TO  10 


COL-COL- 1 
!>0  TO  10 


> NUMBER ( CAROf COL t MAP  tlSTART) 


PUNCH  CARO  (PUNCH  STATISTICS  ON  CAROS) 


215 


M - FIN012(CAR0.C0L»CHAR) 
IF  (M  .NE.  ?)  PUNCH  • ' 


IF(M.NF.2)G0  TO  24S 

NUMBER (CAR0«C0L«PUNCH  tISTART) 


^0  TO  245 
MAP  FORMAT  CARO 


220 


M * NXTCHRJCAROtCOL) 

IF  (M  ,EO.  UBCD)  MAPFMT 
IF  <M  .EO.  LBCD)  MAPFMT 
1F(M.F0. BLANK)  MAPFMT-1 
GO  TO  10 


1 

2 


CLUSTERS  CARD  (MAX.  NO.  OF  CLUSTERS  PER  CLASS) 


230 


JsNXTCHR (CARD. COL) 

IF  (J.FO. BLANK)  GO  TO  10 
COLsCOL-1 

^ s NUMBER (CARO. C0L»MAXCL3»ISTART) 


jO  to  10 


CHAIN  CAPO  (CHAIN  CLUSTERS  WHICH  ARE  OLMlN  UNITS  APART) 
ICHN-1 

J=FLTNUM(CARO.COL»CHNTHS»l) 

GO  TO  10 


OPTION  CARO 


240 


J ■ NXTCHR(CARD.COL) 

IF  (J  .EO.  BLANK)  GO  TO  10 


ORDER  COLOR  KEYS 
IF(J.EO.ORCD)  lOROER 
ERROR  COMPUTATION 


IF(J.NF.EPCO)  GO  TO  24l 
COL=COL*l 


JsNXTCHR (CAPO. COL) 


IF(J.EO.CBCD)  ERCOMP-1 


GO  TO  ?A5 
CONTINUE 


PUNCH  CARO 

IF  (J  .EO.  PBCO) 

STATS 


GO  TO  215 


IF(J.NE.SPCO)  GO  TO  242 
JsNXTCHR (CARD. COL) 
IF(J.FO.THCD)  STATKY-1 

continue 

CLUSTERS  FOR  mapTAP 
1F(J.EO.CPCO)MAPKEY=2 


FIN012  A COMMA 


J=FIND12(CAW0.C0L.C0MVEC> 
IF(J.LE.O)GO  TO  10 


SET02380 

SET0235o 

SET0240Q 

setojaIo 

SET02420 

SET02430 

SET02440 

SET024S0 

SET02460 

SET02470 

SET02480 

SFT02490 

SET02506 

SET0|5l^ 

IItoIIIo 

SET02540 
SET02550 
SET02560 
SET0|S70 
SET02S80 
SET02590 
SET02600 
SET026iO 
SET02620 
SF.T02630 
SET02640 
SET02(SSO 
SET02660 
SET02670 
SET02680 
SET02690 
SET02700 
SET02710 
SET02720 
SET02730 
SET0|740 
SET02750 
SET02760 
SET02770 
SET02780 
SET02790 
SF.T02800 
SET02810 
SET02820 
SET02B30 
SET02840 
SET02B50 
SET02860 
SET02870 
SET02880 
SET02890 
SFT0290I 
SET029K 
SET02920 
SE702930 
SET02940 
SET02950 
SFT02960 
SFT02970 
SET02980 
SET02990 
SFT03000 
SET03010 
SET03020 
SET03030 
SFT03040 
SFT03050 
SFT03060 
SET03070 
SFTC3080 
SFT03090 
SFT03100 
SFT031 10 
SFT03120 
SET03130 
SFT03140 
SF.T03150 
SET03160 


riLCi  SETUP? 


248 


60  TO  240 
SEQUENCE  CARD 

M8NXTCHR(CAR0tC0L> 
irCM.fO. BLANK)  60  TO  246 
SEQUEN( I)*M 
I8l»l 
fiO  TO  247 


C 

C 

C 


249 


NOSEQ  *1-1 
00  TO  10 

PERCENT  CARD  ' 

J»NXTCHR(CAROfCOL) 

IF (J.EO. BLANK)  60  TO  10 
C0L*C0L-1 


C 

i 


J*NUMBER(CARO»COLfIPCTtJ» 
*ERCEN*} .-FLOAT ( IPCT) /lOO. 
60  TO  10 


MEANS  CARO 


GO  TO  10 
60  TO 
60  TO 


250  J * NXTCHR<CARO,COU 
TF(J  .EQ.  BLANK) 
iF(J  ,E0.  CBCO) 

IF(J  .NE.  FBCO) 

IsOKEYaJ 
60  TO  10 
ISOKEY*! 

CALL  ROMEAN (ARRAY) 

60  TO  10 

READ  MODULE  DECK  AND  WRITE  TO  INPUT  STAT  UNIT  AND  FILE. 

SAVElsSAVTAP 
S4VE2=STAFIL 
SAVTAPsiNUNIT 
STAFIL=INFILE 
CALL  CPOSTATaRRAY*TOP) 

5AVTAP=SAVE1 
STAFIL*SAVE2 
INITM=J 
60  TO  10 

data  FILE  CARO 
260  M = NXTCHR(CAPO»COL) 


255 

C* 

8: 

256 


IF  (M.EO. BLANK)  GO  TO  10 
IF  (M.EQ.liBCO)  60  TO  ^5 
IF(M.EO.FBCD)  60  TO  267 

263  WRlTE<6t750) 

750  format  (•  ERROR  ON  DATA  FILE  CARO') 
60  TO  10 

265  J = FINOl?(CARO.COLtEQUVEC) 

IF  (J.FO.  -1)  GO  TO  263  . 

M ::  number  (CAROtCOL»OATAPE*ZERO) 

COL  = COL  - 1 
GO  TO  P60 

267  J « FIND1?(C4RD.COL*EOUVEC> 

IF  (J  ,fcO.  -1)  GO  TO  263 
M = NUM4EP(CAR0tC0L«DATFIL»ZER0) 

OATriL  = datfil  - T 
IF  (DATFIL  .LT.  0)  OATFIL  ■ 0 
COL  * COL  - I 
GO  TO  260 

STAT  file  CARO 

>70  M=NXTCHR(CAROtCOL) 

271  IF(M.eO, IPCD)  GO  TO  278 
IF(M.FQ.URCn)  60  TO  275 
IF(M.E0,FPC3)  GO  TO  277 
IF  (M.FQ.OPCf.)  60  TO  272 
IF (M.EO. COMMA)  GO  TO  270 
IF  (M.FQ, PLANK)  GO  TO  10 
273  WPITF(4.7SS) 

755  format (•  ERROR  ON  STATFILE  CARO*) 


c 

c 

c 


-3« 

T03|  . 

T0328t 
,_T03290 
SET03300 

i^Tosilo 

SET03330 

SET03340 

SET03350 

SET03360 

SETO3370 

SET03380 

SET05390 

SET034P9 

SET03410 

SET03420 

SET03430 

SET 03440 

SET03450 

SET03460 

SET03470 

SET03480 

SET03490 

SET03500 

SET03510 

SET03S20 

SET03530 

SET  0 3540 

SET03550 

SETO3560 

SET03570 

SET03580 

SET03590 

SET03600 

SET03610 

SET03620 

SET03630 

SET03640 

SET03b50 

SET03660 

SET03670 

SET03680 

SET03690 

SET03700 

SET03710 

SET03720 

SET03730 

SET03740 

SET037S0 

SET03760 

SET03770 

SET03780 

SET03790 

SET03800 

SET03fllO 

SET01820 

SET03B33 

SET03840 

SET03850 

SET03B60 

SET0387Q 

SET03880 

SFT03890 

SET03P00 

SFT03910 

SFT03920 

SET  03930 

SET03940 

SET03950 


FILEI  SETUP? 


27? 

274 

275 

277 

278 

279 

281 

282 


C* 

C* 

8: 

283 

C* 

C* 

C* 

284 


C 

C. 


300 

301 


305 


310 

315 


GO  TO  10 

J>F I NO 1 2 ( CARD  f COL • SLASH) 

TF(J.F0.-1)60  TO  273 
M«NXTCHR<CAR»)tCOLy 

iFCM.EO. COMMA)  GO  TO  274 
F(M.EO.F«CD)  60  TO  277 
F(M.NE.UPCO)  GO  TO  271 
J«F INDl 2 (CARO»COLtEOUVEC) 

IF{J.F0.-1)G0  TO  273  . ^ ^ 

MbNUMRER ( CARD « COL  * S AVT AP  t ZERO) 

COL=COL-l 
GO  TO  274 

J=FIN012(CARD.COL*EOUVEC) 

1F(J.F0.-1)G0  TO  273 
HbNUMRFR ( CAROfCOL  * ST  AF IL  * ZERO) 

COL=COL-l 

GO  TO  274 

J=FIN012(CAR0.C0L*SLASH) 

IF(J.EQ.-l)GO  TO  273 
INITM  » I 

MsNXTCHR (CARDfCOL) 

iF(M.EO. COMMA)  GO  TO  279 
F(M,E0.FRC0)  go  to  282 
F(H.NF.UBCn)  go  TO  271 
J=F1ND12(CAPD.C0L«EQUVEC) 

IF(J.EO.-l)GO  TO  273 
MsNUMRER ( C ARO f COL » I NUN I T * ZERO ) 

COL*COL-l 
GO  TO  ?79 

JsF 1 NO 1 2 ( C ARD . COL . EOUVEC ) 

IF(J.FO,-1)GO  TO  273 
MaNUM3FR(CARDtC0L»INFlLE»ZER0) 

C0L=C0l-1 
60  TO  279 

SUBCLASSES  CARD— USE  THE  MEANS  FOR  THESE  SUBCLASSF.S  FROM  THE 
STAT  FILE  FOR  INITIAL  MEANS 

N0SU82SNUM8ER « C ARD . COL  t SUBVEC » N0SUB2) 

GO  TO  10 

MINIMUM  POPULATION  FOR  STATISTICS  PASS# 

J=NXTCHP (CARO. COL) 

IF (J. NF. MINUS) COL=COL-I 
MsNUMHER(CAPO«COL*PMIN#ZERO) 

IF(J.EO.MInUS)PMIN=0“PMIN 
GO  TO  111 

DOTFIL  INPUT/(INIT=N#FILE»M 
OR  UNITsN.FILEsM 
J=NXTCHR(C4RO«COL) 

IF  U.EO. BLANK)  GO  TO  320 
IF(J.NE.UGCO)  GO  TO  305 
J=F I NO 1 2 ( r APO . COL t EQU VEC ) 

IF  (J.Nf .?)  GO  TO  320 
fSTAPTsO 

JsNUMBER (CAPO.COL# ARRAY ( TOP-30 ) tISTART) 

OOTUNT  = ARPAYdOP  - 30) 

JsFiNOl? (CAPO. COL tEOUVEC) 

IF  (J.NF .?)  GO  TO  320 

ISTART=0  . . 

JaNUMBER (CAPO .COL. ARRAY ( TOP-30) »ISTART) 

OOTFIL=ARPAY (TOP-30) 

DOTFIL  s nOTFIL  - 1 
GO  TO  10 

IF(J.NF.IPCri)  GO  TO  310 
JaFINDl 2 (CARO. COL. SLASH) 

IF  (J.MF.2)  GO  TO  320 
J 8 NXTCHP(CAwn.COL) 

IF  (J.FO.KHCD)  GO  TO  315 
IF  (J.FQ.UBCO)  GO  TO  301 
GO  TO  320 

IF  (J.NF.FPCO)  GO  TO  320 
J 8 FlNni?(CAPO. COL. EOUVEC) 

IF  (J.Nt.2)  GO  TO  320 
ISTART  = 0 

J a NUMHFP (CAPO. COL.  ARRAY ( 'OP  - 30) .ISTART) 


y 

40 

50 

118 


SET03960 

SET03970 

,]8i8f“ 

'T040C 
•T040} 

juts. 

SgT0404fi 
SET04050 
SET04060 
SET04070 
SET04080 
SET04090 
SET04I 
SET04 
SET04 
SET04 
SFT04j 
SFT04j 
SET04 
SFT041 
SET04180 
SFT04190 
SET04200 
SFT04210 
SET04220 
SET04230 
SET04240 
SET04250 
SET04260 
SET04270 
SET04280 
SET04290 
SET04300 
SET04310 
SFT04320 
SFT04330 
SET04340 
SET04350 
SET04360 
SET04370 
SET04380 
SET04390 
SET04400 
SFT04410 
SET04420 
SET04430 
SET04440 
SET04450 
SET04460 
SET04470 
SET04480 
SET04490 
SET0450Q 
SET04510 
SET04520 
SET04530 
SET04540 
S6T04S50 
SET04560 
SFT04570 
SET04580 
SET04590 
SFT04600 
SFT04G10 
SFT04b20 
SFT04630 
SFT04640 
SET0M650 
SET04t)feO 
SET04670 
SFT04G80 
SET04690 
SET04700 
SET0I.710 
SET0<.720 
S'’T0i.730 
SET04740 


riLEl  SETUP? 


60 


340 


345 


J°I^^'[NDl?KftP^I?OLTEOUVEC)  * 

IF  (J.Nt.2)  GO  TO  3P0 

J^«NUMBEP<CAPD»COLt ARRAY (TOP  - 30)»ISTART) 
OOTUNT  * ARRAY (TOP  - 30) 

GO  TO  10 
WPlTE(6t760) 

FORMAT (•  ERROR  ON  OOTFILE  CARO') 

GO  TO  10 
SUNANG 

J»NXTCHR(CAR0»C0L)^  . ^ 

IF{J.NE.TRCD)  GO  TO  345 

1SUNT«1 

GO  TO  10 

ISTARTaO 

COL  * COL  - 1 

J*NUMBFP (CARD. COL. ARRAY (TOP-30) * 1ST ART) 


IF  (J.GT.8)  J a 8 
inj.EO.O)  GO  TO 


. 10 

ISUNCaO 
DO  350  JJ=l.J 
ISUNC=ISUNC*1 

350  SUNANG (JJ) -ARRAY (TOP-31 ♦ISUNC) 

GO  TO  10 

: DOTS 

380  ISTAPT«0 

J = number (CA»0*COL.STOOTS(NSOOTS  ♦ 
NSDOTS  = MSDOTS  ♦ J 
IF(NSDOTS.GT,60)  MSDOTS»60 
GO  TO  10 

I ^END*  CARO 

280  CONTINUE  ^ ^ ^ 

IF  (NOFEAT  .GT,  0)  GO  TO  285 
NOFEAT=30 
DO  261  1=1.30 
261  FETVEC(I)aI 
285  CONTINUE 


D.ISTART) 


C* 

C* 

C* 


PRINT  USER  REOUESr 

WRITE (blftTO) ISTOP.NMIN.KRN.MAP.MAXCLS.NCLASS* 

* (FETVEv’d)  .lal. NOFEAT) 

WRlTE(6.660>nLMTN.STDHAX 

WRITE  (6.68S)  IPCT.PMIN.NSDOTS.ISUNC.ISUNT 
IF(SPTRlG.ED.l)WkITE(6.690)SEP 
IF ( ICHM.EO.l ) WHITE (6.710) CHNTHS 
IF(PUNCH.FQ.l)  WRITE(6.70()) 

IF(10RnEP.F0.1)WRITE(6.7Y5) 

IF (MADFMT.EO.l ) WRITE (6.720) 

IF (MAPFMT.F0.2)WRITE(6»725) 

IF  (NOFEAT  .GT,  NMlN)  WRITE(6»740) 

RETURN 

480  FORMAT (A4.6X. 6241)  

490  FORMAT  (•  INYAI.ID  INPUT  CARD— IGN0RED»/T5i  A4.6X.62A1 ) 

500  format (10X.1SA4) 

510  FORMAT ( 10X.3AA) 

550  FORMAT (7X.A4.4X.62A1) 

640  FORMAT  (‘•^CHANNELS^CAN^  BE*  CHANGED  UNTIL  THIS  EXECTUION  OF  ISOCLSS6T0|380 
650*FpMATd*’^^°OF  CLASSES  CANNOT  BE  CHANGED  UNTIL  THIS  EXECUTION  OF 

660*FORMAVu//*‘'YOU*'HAVE'kLECTEO  THE  FOLLOWING  PARAMETER  VALUES  AND 

• OPTIONS'//) 

670  FORMATC  stop  AFTER*. 15. • ITERATION(S)  • / 

ALLOW  A minimum  of*.  16.*  PiXEt.S  PEP  CLUSTER'  / 

PRINT  A cluster  SUw>mARV  FVERY'.IS.*  ITtRATION(S) 

PRINT  A CLUSTER  MAP  EVFPY'.IS.*  I TEH AT  ION ( S ) • / 


SET04750 
s|T04760 
5FT0477 

Disiii 

SET04800 

imim 

IliSiilS 

SFT04870 
SET04H80 
SET04890 
sIT04900 
SET04916 
SET04920 
S£T0493Q 
SET04940 
SET04950 
SET04960 
SET04970 
SET04980 
SET04990 
SET05000 
SFT05010 
SET05020 
SET05030 
SET05040 
SET05050 
SET0506Q 
SET05070 
SET05080 
SET05090 
SETOSlpO 
SET05110 
SET05120 
. SET05130 
SET0514' 
SET05I5 
SET0516 
SET05170 
SET05180 
SET0S190 
SET05200 
SET05210 
SET05220 
SET05230 
SET05240 
SET05250 
SET05260 
SET05270 
SF.T05280 
SET05290 
SET05300 
SET05310 
SET05320 
SET05330 
SET05340 
SET05350 
SET05360 
SET05370 


* 

* 

» 

• HAVE 

680  FORMATC 
68S  FORMAT (• 


ALLOW  A MAXIMUM  OF*.JS.'  CLUSTtRS  PER  CLASS*  / 
THE  STATISTICS  FILE  wiLL  BE  WRITTEN  AFTER*. 14.* 


BEEN  CUISTtRFOt  / 

* CHANNELS  ARE--- 
OLMlN  =*.  F7.3 
PfRCFNT  =*.I5 


*.  3013  ) , 

/ • STUmAXs* .F7.31 
/•  PMIN  **.15  /•  NSDOTS  =*.15  / 


SET05390 
SET05400 
SET05410 
SET05420 
SET05430 
SET05440 
SET0S450 
SETOS460 
SET05470 
SET05480 
CLASS(ES)SFT05490 
SETOSSOO 
SET05510 
SFT05520 
SET0S530 


'/ 


//C.3 


flLft  SETUP? 

..  NO.  SUN  ANGLES  FROM  CAROS  -NI5  /'  SUN  ANGLE  TAPE  S-  -.15/) 
Eilli  ^ UNITS  APA.T.) 

?5?  p^g2s5ii}?*i23iRNIN6S*^®NM^  ffisS^THAN'*No!%^*CHANNtLS.COVARlAN| 

’^°*CFS  PILL  NOT  RE  INVERTIBLE*)  S 

en5 


FlL*f:  SUNr*C 


C*ENn 

c 


*!U«R0UTTNE  *;UNFftC(SUNCOH.SUNANG*rETVEC»WFEATtISUNC*lSUNT) 
TNTEGEA  SUNftNG.FETVEC.SUNA 

FQIIIVALENCE  (Fx.TMA(n  vOUMKD)  * (EXTRAn09)«DUM2(l))» 

niMfTNSTON  £'<TR«(32<»),?;UNANGa)  *FETVECU)  fSUNCORU)  t 
•OUMl  (inA)  ,Ol)«2nOM)  *OUH3<  108» 

INCLUOF  COMMK6 

COMHON/GLOBAL/hf *0(63) .MAPTAF»OATAPE»SAyTAP*BMFILE»BM«EY* 

• HISFlL.HlSKEY.TRFORH.ENlPTP.EPPKEY.HAPONTfNOFlLF* 

• nPUM»n.ORMwOS.PAGSl^»nATFiL»S'IAFIL»ASAV*ASAVFL 

• ,nhstun.nmstfi.sct.^un*m#pfil 

• .DOTUM.nOTf  !L.NCHHASfTPNSFU«BMTRFL.HlSTFL»PCHUNT* 

• CRDUNT.M«TiJNT»WANDIO 


OATA  DUMl 


_ /16.4l3»14.fl87»U.O«9fl3.A01» 
*13.(?15.U.90i,11.323ilp.?lA«l0.7|5i9.fi«»3*9.449»9.052* 


•9, 094. 4. 413 
44,AAn,f.,4?^ 
♦ S.474.“i,  15#> 
*4,530.4.297 
*4,1(S3.3.9hl 
•3.5A0.3.4PA 
•3.135.3.0)5 
*?.7AH.?,6'»3 
•P.511.P.435 
*?.393.?.32'=i 
*?. 187. P.131 
•P.01^,,1  .971 
•).«71,l.fl34 
DATA  0lf^2  /I 
•1  .6°3. 1 .665 
•1  .504.1.571 
*1  ,50H.  1 .4.09 
•1.41?, 1.4)7 
•1  .366.1.353 
•1.336,1 .3P4 
*1  .POC, 1.271 
•1  .P30.) .PP3 
*1  .1P6, 1 . IBO 
♦1 .146,1.14? 
•1  .)?fl. 1.124 
•1 .094 , 1 .091 
•1.064,1 .06? 
•1.016.1,035 


6.063 

6,19(, 

4.991 

4.174 

3.555 

3.344 

2,952 

2.643 

?.195 

?.?A9 

?.1(»2 

1 .947 

1 .«15 

.748.1 

1.651 

' .559 

1.479 

1.409 
1 .147 
1 .115 
1 .266 
1.219 
1.177 
1.140 
1 ,1?2 
1 .090 
1.061 


7.745 

5.973 

4.838 

4.061 

3.757 

3.269 

2.H93 

2.597 

2.358 

?.25S 

?.076 

1.9PS 

1.797 


1.637 

1.548 

1.470 

1.402 

1.34  1 
1.313 
1.261 
1.21b 
1.174 
1.137 
1.120 
1.089 

1 i060 

1.034 


7.832 
6,098 
4.967 

3.852 
3.342 
2,953 
2.642 

2.285 
2.097 
1.940 
1.807 
.717.1.701. 


1.642 

1.550 

1.469 

1.398 

1,307 

1.255 

i.2oe 

1.166 

1.111 

1.078 

1.050 

1.023 


1.035 

nflTA  nU'-'3  /l. oil. 1.011, 1,011. 
•1  .000, 1.000. 1. 000. I.UOO.,959 


*.979 

*.960 

* . 94  3 

* .975 
*.Q?1 
*.90H 

* .807 
*.857 
*.878 
».875 
*.868 
•.563 

*.850 

nATA 


.979 

.961 
.044 
.929 
.923 
.910 
.899 
.890 
.881 
.578 
.571 
.566 
.»62 
PLA6K/ • 


.95(1 

.961 

.945 

.930 

.024 

.9)1 

.901 

.891 

.583 

.579 

.^-73 

, P5H. 
.564 

•/ 


.950, ,069. .970 
.962. .951, ,952 
.946, .935, .937 
.931, 

.925, .914, ,916 
.912, .902, .904 
.902, .592, .894 
.892, .882, ,885 
.554, 

.5"1,.571,.574 
.575, .565, .869 
.5  70. .5A) . ,564 
.566. .857 . .861 


7.285 

5.722 

4.694 

3.675 

3.207 

2.846 

2.557 

2.223 

2.047 

1.899 

1.773 

.687, 

cm 


1. 


7,00? 

5.527 

4.551 

3.583 
3.135 
2. 789 
2.513 

l;J|l 

i;?IS 

1,603 

1.518 

1.443 

1.377 

1.242 

1.198 

1.158 

1.106 

1.075 

1.047 

1.022 


6.744* 

5.346, 

4.419* 

3.497* 

3.069* 

2.737* 

2,471* 


1.435* 

1.370* 

1.286* 

1.238* 

1.195* 

1.155* 

1.104. 

1.074* 

1.047* 

1.022/ 


990*. 990* 
971* 

954* 

938* 

918* 

907. 

897* 

888* 

878* 

872* 

868* 

864/ 


0 

no  POO  IsI.noffat 

K=  (FFTVSr  ( I ) -I  ) /foCMPAS 
IF  (I9UMr.Ni-*.0..''MO.I,£l).l)  K5sK 
KOiFFTVtC  ( I ) -K*IICwPaS 
KsK*l 

SIINA  = SUiJflN''-(K-KS) 

100  INn=(5HNA-5l*IJCHPA5*KR 

AllMCOP  ( 1)  =HXT9/.  < IHD) 

,200  rOl9TINIIP 

w9TTn(«.,90» 

on  format (//761 . 'SUN  ANGLES*/) 

WOTTP  (6.210)  (SUNANG(I),  1 s 1*8) 

Pin  FOOmaT  (T45.*»15) 

S9TTF  (A,?!*,) 

215  FOomaT (//TS». 'COHRFCTiOwS  FOR  SUN  ANGLES*) 

e 

NOFETR  = NOFFAT 


5UN0Q010 

SUNOOOfO 

lUNOpOSO 

SUN00040 

SUN00050 

SUN00060 

SUN00070 

5UNpo080 

SUN00090 

SUNOOlpO 

SUNOOlIO 

tUNOOiPO 
UN00130 
SUNOOj 
fUNOO 
fUNOOj 
SUNOOj 
SUNOO 
SUNOOl  . 
SUN00200 
SUN00210 
SUN00220 
SUN00230 
SUN00240 
SUN00250 

fUN00260 
UN0027P 
SUN002H0 
5UN00290 
SUN00300 
5UN00310 
SUN00320 
SUN00330 
5UN00340 
SUN00350 
SUN00360 
5UN00370 
SUN00380 
SUN00390 
SUN00400 
SUN00410 
SUN00420 
SUN00430 
SUN0Q440 
SUN00450 
SUN00460 
SUN00470 
SUN00480 
SUN00490 
SUN00500 
5UN00510 
5UN00520 
SUN00530 
5LIN00540 
5UN0C550 
5UN00560 
SUN00570 
SUN00580 
5UN00590 
SUN00600 
SUN00610 
SUNO0620 
5UN00630 
5UN00O40 
5UN006S0 
SUN00660 
SUN00670 
SUN006H0 
SUN00690 
SUNOO? 00 
SUN00710 
SUr,007?0 
SU*)00730 
SUN00740 
SUN00750 
SUN00760 
SUN00770 
SUNn0780 
SUN00790 


FILft  SUNF«C 


217 


220 

230 


istart  » 1 

--M0  « 16 

(lEMD  .6F. 


i[ 


NOFFTH)  lENO  • NOFETR 


TE'^n?  • ISTAfcT  * lENO  - 1 
WRTTF(6.2201 (hLANK.FETVEC «I ) t I«1START. lENOS) 
format (//lA«lh(Al, iCh( t*!?*') • «1X) 1 
VRTTF (6,230) (SUNCOR(l) ,1>ISTAHT,1ENDS) 
format ( 16(?X,F6.4)) 

NOFETR  a NOFFTR  - lEND 
TSTART  • lENOS  ♦ 1 
IF  (NOFETR  ,LE.  0)  RETURN 
00  TO  217 
FNO 


fUNOOROO 

tUNOOOlQ 
UN00B20 
SUN0003 
SUNOORA 
SUN00)j5 
SUN00R60 
SUN00R70 
SUNOORRO 
5UN00690 
SUNOOROO 
Sl'NOOViO 
S(jN00920 
«"N00930 


fIL£  TAPHOR 


r**< 

r* 

C« 

r« 

cc* 

c* 

r# 

c* 

r* 

r* 

r* 

r« 

r* 

r* 

c* 

c* 

c* 

r* 

c* 

c* 

c* 

c* 

r» 

r* 

C* 

f 

€♦ 

C* 

C* 

r* 

r* 

r* 

r**( 

C* 

C* 

r# 

C* 

r* 

c* 

r* 

r# 

r* 

r« 

c* 

r* 

r* 

r* 

r# 

r* 

C* 

r* 

r* 

c* 

r* 


TAPERO  READS  ?”£  mulT  I SPECTRAL.  SCANNER 
REOUrSTEO  UAIA  AND  RETURNS  IT  UNPACKED 
THERE  ARE  THREE  SEPARATE  SUHROUTlNES* 
ANO  LlNERO.  NEEDED  TO  READ  A TAPE 

TAPMDP  must  re  called  once  TO  READ  THE 
NECESSARY  DATA  fROH  THE  HECONO 


DATA  TAPE*  UNPACKS  THI 
TO  THE  CALLING  ROUT  INI 
TAPHOHt  FLU I NT 


L 


SO«»OUT1nE  TAPHOR«nATAPt»IFlLE)  1^552915 

Wod 

TAP00060 

mm 

TAPOO 
TAPOO 
TAPOO 
TAPOO 
TAPOO 

v.m 

TAPOO 
TAPOO 
TAPOO 
LOTAPOO 


HEADER  RECORD  ANO  UNPACK 


00 


CALL  TAPHDRIOATAPE, 
OA  “ 

IF 


[FILE) 


kr:‘SV^n:o2V!|'l!N'^8!i!*HRl‘5lEss.sHE5To 

IN  ORDER  TO  POSITION  TAPE  TO  DESIRED  FILE 


READ  OVER 


FlD^jT 
TO  THE 


MUST  »E 
CORRECT 


called  omce  For  each  fieud.  the  tape  is  position! 
recoho  and  parameters  ape  initialized  for  the  F 1! 


0 


CALL  F'LniNTIRLOCK.FETVEC.NOI-EAT) 

hlucmixine  start 

HLOCMP)»LfNH  END 
HLUCrOlBLlNE 
HLOCK<A)»SA4PL 
"LOCK (S»*SAMPL 

continue 

HLOCK  <N)sSAMPLF 

FFTVFC-  IINPIIT)  _ 

NOFEAT  (I»4PUT)  no.  of  FtATURES  IN  F 

CALL  LlNEPOnOATA.ENDTAP) 
ioata 


increment 

VECTOR  CONTAINING  Ff 


ATURES  REQUESTED 
TVEC 


<OUTPUT)  ARRAY  containing  UNPACKED  DATA 
FNOTaP  - TIGOPB  indicating  RHEThFR  of  not  an  e-o-f  has  bfen 
REACHED  while  trying  TO  READ  A GIVEN  SCAN  LINE  NO. 

IF  an  e-o-f  Is  founo  enotap  « -i*  otherwise*  enotap 

« 0, 


TAPQ02ZO 
TAPOoSSO 
TAPOOZAO 
TAPOO|50 
TAP002GO 
TAP00270 
TAPOOZHO 
TAP00290 
TAP00200 
TAP00310 
TAP00320 
TAP00330 
TAP003AO 
TAP00350 
TAP0OJ6O 

tapooSto 

TAPooaao 

TAP0039' 


ready  is  a Indicator  to  test  whether  the  Taps  has  been 
positioned  ANO  PAPaMETEkS  set  for  a field 

THE  arrays  nr  and  hwru  ARE  PRECALCULATED  WORD  AND  BIT 
POSITIONS  OF  I'JFOOHATION  iN  THE  HEADER  RECORD  OF  THE  UNIVERSAL 
FO-haT  WHICH  MUST  PE  EATRACTEO. 

CONTINUE 

MWPDS  - NO.  OF  OFC0R05  PER  DATA  SET 


rAP 


OOMO 

OORl 


NPPC  - NO.  OF  PHvSICal  RECORDS  PfP  CHANNEL 
anCLNG  - ancillary  length  IN  HYTEC 
NC  - NO.  OF  channels 

NS  - NO.  OF  samples  per  channel  per  SCAN 
NHITS  - NO.  OF  BITS  REP. PIXEL 

noi  - DATA  ohoer  Indicator 

NOSPR  - NO.  OF  DATA  SETS  PER  RECORD 
NCAR  - NO.  OF  channels  OF  VIDEO  DATA  ON  SAME  RECORD 
WITH  ancillary  DATA) 

SVD  - start  of  video  data.  (BYTE  POSITION  WITHIN  DATA  FOR 
A GIVEN  CHANNEL) 


TAPOOSlO 

TAP00S20 

TAPO0530 

TAPOOSMO 

TAP00550 

TAP00S60 

TAP00S70 

TAP00580 

TAP00S9Q 

TAP0060Q 

TAPOOtolfi 


TAP00620 

TAP00630 

TAP006R0 

TAO00650 

TAPOOG60 


LOGICAL*  1 iHnFCjniSOO) 

LO(ilCAL*l  l«'OWI)(<.),  ILINE(4) 

01  ME  NS  ION  fRM(  »..♦» 

dimension  N-»(PP)  .hwW0(2M)  . , 

common  /TAPf.^u/  Ii)MT«UPST.FSCAN»SAMENO*SAM|NC*READYiNSCAN.  TAP00670 

• LlNC.  IU(?ft-)  ..)SL  .LHUF(30)  .JRECOO)  t IMYTEOO)  .NbUFS*FlLtNO.LlN£NDTAP006H0 

• .LlNlNC.NSAMp.fjnCHAN.FORMT  TAP00G9« 

COMMON  /IDSIOR/I'IDI^hO)  TAPOO.i’OO 

COMMON  /ISOL'-a/ShnanGIB)  f 1ShnT»1SUNC.SHSTR.SMSTP*SM1NC*L1NSKP  !*iJ00U2 

fohivalence  (I *ow().*ioro) 

FOutvALENCF  (IFPST, ILINE)  I?S55Z?9 

equivalence  (ion),NWPi)s  ) . (10(2) .ncpr  )* 

• (Il'CO.NPPC  ) . ( 10(4)  , ANCLNG)  • TAP007S0 

• ()|t(S).NC  ). (10(6). NS  )*  TAP00760 


¥(■'? 


file  taphdr 


( D(7),nHiITS  )<(lD(8)fD0n* 
( 10(10)  ■ 

)c  l).5vr  — 


(in(y).NUSRH)«(IO(10)*NCAR  )f 
(10(11)  .«;v0)  . (10(16)  .RRSZ) 

•UN1V***F«SA».*L  •.•LA#S»»‘YS  2*» 

AN0»*'S4T  un/2  *♦ 'LAN0»1»SAT  •*•3  •/ 

10J,|0S»9O,17rt7.9j|.l()7.177«.T7H'>.9|.10«tll0t 
.^?0if22nj,220S.2au7*2209«22ll«2h3«2hs. 


n 

f* 

r* 

r* 

r« 


it 

7 


5 

6 

C» 


DATA  F6M/ 

• » •«»LAN0‘ 

DATA  HifPD/lnA*102>'  ' 

• I7H9. 1791. loo 

♦ 61. 6?. 63.67/ 

OATA  Un/'  . 8. A. 1 6* A. 1 6. 3. 8* 9 . 1 6. 1 6. 16. 16. 16. 16* 16. 

* 16*16.16. 16. 16*16*16. 16. 6.8*6.16/ 

ENTRY  FOR  READING  HEADER  INFORMATION 

information  in  ERCOIC  or  IRH  FLOATING  POINT  IS  NOT  UNPACKED 
FROM  THE  HEADER  RECORD  AT  THIS  TIME. 

ready  » -1 

IFRSt  ■ 0 
FIlEno  ■ IFIiE 
HjNlT«OATAp| 

remind  idnit 

SKIP  DIRECTORY  FILE  FOR  LANOSAT  3 

lF(rORMT,NE.4)GQ  TO  2 
«EAO(  IUN1T.510.ENO»<.)OUMMY 
<iO  TO  3 

fileno*fileno*3 

REC  « 0 
KR'JF  * 3060 

IF  (ISUNC.NE.O)  GO  TO  6 
no  5 1 • 1.9 
sunan6(I)  > 

CONTINUE 


60 


610 


P. 

600 


11 

10 

20 

12 

3S 


NWPn9»l 

IF  ( FILENO  .EO.  0)  GO  TO  600 
DO  A 1*1. FILENO 
IF(FORmT.NF,*)wRITF(6.610)  I 
FDwmaTC  SKlPPl»iG  FILE'.IS) 

IF (FowNT.NE.4)G0  to  7 
lJ»I/3 

IF  (MOUd  .3)  .EQ.O)wmTF,(6.6lO)  IJ 
WEAI)(  IUNIT.610*ENOs6)OMMHY 
GO  TO  7 
CONTINUE 

if(Fdrmt.eo.?)  go  to 
IF (FORMT.f Q.3) GO  VO  ’000 
IF  (FiihIMT,E0.6)G0  to  too 

CALL  HUF ill  (RFC . IUnTt .KbUF. IHUF .NRPOS.ENOTAP. IERR) 
IF  I IERR  .to.  -1)  GO  TO  11 
FOHMT  « 1 
GO  TO  20 
KHUF  B 600 
REC  » 0 

CALL  GUFILL  (Wf C. IUNIT.KMIF, ID.HRPDS.ENOTAP. IERR) 

IF  ( IERR  .EO.  -1)  GO  TO  lO 
FORMT  * 2 
GO  TO  20 
WRITE  (6.280) 
wWlTElb.340) 

CALL  CmErR 
IF  (FORPT  .EO. 

IF  (FORM!  .Nf. 

■ Isa. 200 
)<10(I) 

>NG 

PRS7  » NCS  . A 
IF  (PRSZ  ,LE.  30600) 

W»ITF(n,330)NC.NS 
CALL  CHERR 
CONTINUE 
NRPUStl 
HAXREC  * PRSZ 


jr  irw" 
00  12 
I[‘n(T) 
nCs=nC« 


■n 

2) 


GO 

GO 


TO 

TO 


40 

265 


GO  TO  3S 


TAP00770 

IapooIIo 

TAP00800 
TAP00810 
TAP00820 
TAP00830 
TAP0084D 
TAP008S0 
TAP00860 
TAP00870 
TAP00880 
TAP00890 
TAP00900 
TAP009iO 
TAP00920 
TAP00930 
TAP00940 
TAP0095Q 
TAP5o960 
TAP00970 
TAP00980 
TAP00990 
TAPU  000 

TAPo  oTo 

TAP01020 
TAP01030 
TAP01040 
TAPOIOSO 
TAP01060 
TAP0107Q 
TAPO  080 
TAP01090 
TAPOnOO 
TAPO  iiO 

IapoIIsS 

TAPOllAO 
TAPO  ,150 
TAPOiibO 
TAPO) 170 
TAPO.lbO 
TAP01190 
TAPoiaOO 
TAPOUIO 
TAPOilfO 
TAP01230 
TAPO 1 240 
TAP01250 
TAP01260 
TAP01270 
TAP01280 
TAP01290 
TAP01300 

tapoisIo 

TAP01320 

TAP01330 

TAP01340 

TAP01350 

TAP01360 

TAP01370 

TAP01380 

TAP01390 

TAPOUOO 

TAP01410 

TAP01420 

TAP01430 

TAP01440 

TAP01450 

TAP01460 

TAP01A70 

TAPU1480 

TAP01490 

TAP01600 

TAPoiblO 

TAP01520 


(Me' 


riLE  TAPHOR 


r» 

r* 

4»n 


NCARsNC 

ANCLN6«<» 

SV0«1 

N0Tt«;*8 

f>OlaO 

NCPRaO 

^^OSPR■l 

*4PkC  ■ 0 

WRITE (FRm(I*2>  tNC«MS 

SHSTR«1 

GO  TO  loo 

UNPACK  NECESSARY  INFORMATION  FROM  HEADER  RECORD-UNIVERSAL  FORMAT 


TAP01530 


ILIM 
00  NO 
IwO  * 
IF  (1 
WORD  « 
NHYTES 


55 

50 


65 

£••• 

ns? 


70 

no 

Oft 

100 


f* 

c* 

f • 

r« 

c« 


156 


M 

ii? 

J.T.2V, 


I.II^IM 
InO 


?9)  •<» 

> HWRO(l) 


IDI16*!) 


60 


lE  (1.LT.29)  NBYTFS  ■ NB(I»/8 
(TO  55  J»1,N0YTES 
LOC  a N * J - NByTFS 
IPnSaIaf)*J-l 

iwOMD(LOC)  « IBUF(1W0*J-1» 

10(1)  « WORD 
CONTI  ^•u£ 

SmSTH  « 10(1?) 

S’^STH  « 1D(13) 

SminC  ■ lO(lA) 

LlNSKP  ■ 10(15) 

IK  (ISUNT.EO.O)  GO  TO  65 
DO  N?  1*1.0 

IF  (inON*!)  .LT.5.nD.I0(16*I)  .GT.85) 

SM’JAtJGtl)  a lO(lN.l) 

CONTINUF 

WO«l)  ■ 0 
Do  66  T*).N 

JOAT  a ?2S4  ♦ (I  - 1)*8 
1*0RD(A)  » IbwF(IPAt) 

10(159  « 1)  * WORD 

CODE  JUST  amove  added  OCT.20.1978  TO  UNPACK  SOIL  LINES 

IF  (ISUNT.GT.O)  WRITE(6.M«?)  (SUNANG(l).  1*1.8) 
F0wmaT(1m//»  sun  angles  : ».816) 

W^ITK  ) (FKMd.U  .1*1.3)  .NC.NS 

ma.JKC  a PHS7 
IF  (rjpWC.lT.l)  60  TO  80 
W9ITE  (6.360) 

CALL  CmERR 
CONTItJUE 

IF  (SVI).Lt.O)SVD*l 
TF  (N0SHJ.LF.«)NDSPR*1 
IF  (NuITS.K'J.fl)  60  TO  90 
wRITF  (6.390)NMITS 
NHITSsrt 

IF  (OOI.EO.'))  GO  TO  100 
WRHF  (6,<.00)n01 
CALI  CmKRR 

continue 

KPTS*0 

IP0*0 

DATA  SET  length  in  bytes 

osl*anclng.ns*nc 

READ  FIRST  data  SET  TO  DETERMINE  FIRST  SCAN  LINE* NUMBER 

BUFsl 

BECaO 

call  bUFiLL (BfC.lUNlT.MAXRFC.IBUF.NRPDS.ENOTAP.IERR) 


IFBST  s lLlNE(l-6) 

IF  (FuRMT  .EO.  1)  IL1NE(3) 


TAP01580 

TAP01590 

TAP01600 

TAPOIGIO 

TAP01620 

TAP01630 

TAP01660 

TAP01650 

TAPO 
TAP01690 
TAPO 
TAPO 

VaU 

?a"p8 
TAPO 
TAPO 
TAPO 
TAPO 
TAPO 
TAPO 
tapv 
T«PO 
TaPO 
TAPO 
TAPO 
TAPO 
TAPO 
TAPO 
TAPOlVOO 
TAPO] 
TAPO 
TAPOl 
TAP01940 
TAP01950 
TAPO 
TAPO 


960 
..^».970 
TAP01960 


TAPO 


990 


IBUF(71) 


TABOSOOO 

TAP02010 

TAP0|020 

TAP02030 

TAR02060 

TAP02050 

TAP02060 

TAP02070 

TAP02080 

TAP02090 

TAP02100 

TAP02110 

TAP02120 

TAPOflSo 

TAP02140 

TAB02150 

TAP02160 

TAP02170 

TAP021B0 

TAP02190 

TAP02200 

TAP02210 

TAP02220 

TAP02230 

TAP02290 

TAP02250 

TAP02260 

TAP02270 

TAP02260 


file  TAOMDR 


(FORMT  ,F0.  -1)  1LINE(4> 
(FOKMT  .FO.  ?»  ILINEC3) 
(FO«MT  ,FO.  ?)  1LINE<4) 
(IFrfST.GT.O)  GO  TO  120 
WRITE  (6«300) 

WHITE(6*340) 

■ ■ CMERP 


IF 

if 


call  - _ 

120  FSCANxIFWST 

WPITE(b.500) IFRSTfSHSTR' 
RETURN 

?6S  WHITE (6»340) 

call  CMERR 

RETURN 


= IHUF<72) 


» IBUFin 

<2) 


IhUFi 


r 

r 

r 

1000 


r 

c 

c 


c 

c 

c 


c 

c 

c 


SET  UP  FOR  LANOSAT  1 OP  2 FORMAT 

KF)UF=40 

REC=0 

CALL  BUFlLLtREC. IUNIT»KBUF, IbUF.NRPDS*ENDTAP* lERR) 
IF( IE»H.EO.-l)GO  TO  10 

UNPACK  DATA  FROM  _ .,DSAT  1 OR  2 HEADER 

NBITS»8 

001=2 

NHPDS=1 

NCPR=4 

NPHC=1 

ANCLN6=0 

NC=4 

WOH0=0 

IwORO(3)=IRUF»39) 

IkORO(4)=IBuF .-0) 

NS=W0R0/4 

NDiPH=l 

NCAR=4 

SV0=1 

IwORO(3)=1BUF(17) 

I^0P0(4)=IhijF(18) 

PHS7=W0H0 

0SL~NS*NC 

FSCaN=1 

IFBST=1 

SMSTH=1 

»IK1TE(B,4«1 ) (FWM(T«3)»I  = 1»  '^CfNS 

HQITE(6»500) IFRSI*SMSTR 
HtTUHN 

SET  UP  FOR  LANDSAT  3 

KHUF=3596 

REC=0 

CALL  HUF ILL (REC. lUNlTtKBUF* I«UF»NRPDS»ENOTAP» lERR) 
•IF(IERR.E0.-1)G0  TO  10 
NHITS-8 
001=0 
WORD=0 

Iw0k0(4)=IRUF(120) 

TYPE  INUICATOH  0=SEQUENTIAL  1=INTERLEAVE0 
TYPE=0 

IF(OOHO,NF.O)TYPE  =1 

IK (TYPE.EQ,0)NHPDS*1 

NCPP=1 

NPHC=1 

ANCLNG=0 

IF (TYPE.FQ.0)NC=1 
IF(TYPE.EU.0)G0  TO  2200 


c 

c 

c 


SET  NC  AND  NRPDS  FOR  INTERLEAVED  FORMAT 
WORD=0 

=IHUF  (Aft) 

iF(»ioRn,Eo.3)Nwpns=5 

IF(»/OWD.Nt.3)NRP0S=4 


TAP02290 

TAP02300 

TAPOlaiO 

TAP02320 

TAP02330 

TAP02340 

TAP02350 

TAP02360 

TAP02370 

TAP02380 

TAP02390 

TAP02400 

TAP02410 

TAP02420 

TAP02430 

TAP02440 

TAP02450 

TAP02460 

TAP02470 

TAP02480 

TAP02490 

TAP02500 

TAP02510 

TAP02520 

TAP02530 

TAP02540 

TAP02550 

TAP02560 

TAP02570 

TAP02580 

TAP02590 

TAP02600 

TAP02610 

TAP02620 

TAP02630 

TAP02640 

TAP02650 

TAP02660 

TAP02670 

TAP02680 

TAP02690 

TAP02700 

TAP02710 

TAP02720 

TAP02730 

TAP02740 

TAP02750 

TAP02760 

TAR02770 

TAP02780 

TAP02790 

TAP02800 

TAP02810 

TAP02820 

TAP02830 

TAP02840 

TAP028S0 

TAP02860 

TAP02870 

TAP02880 

TAP02890 

TAP02900 

TAP02910 

TAP02920 

TAP02930 

TAP02940 

TAPU2950 

TAR02HfeO 

TAP02970 

TAP02980 

TAP02990 

TAP03000 

TAP03010 

TAP03020 

TAP03030 

TAP03040 


^^7  0 


nr»-» 


riLE  TAPHOR 


?200 


12) 


2210 

2220 

C 


NC>NRPDS 
WORD»0 

IwOPiJ(3)«lBUF(i: 

IwoRo<4)«iquF<i: 

NS*«(OkD 
NDSPR«1 

NCARsl 

SVO=13 

PRSZ»3596  t • 

0SL=3596 

JREC(1)»TVPE 

SKIP  REMAINDER  OF  HEADER  FILE 

PFAD(1IJMIT.510»ENO=2220>  DUMMY 
GO  TO  2210 
CONTINUE 


TAP03050 
TAP03060 
TAP03070 
TAP03080 
TAP03090 
TAP03100 
TAP03110 
TAP03120 
TAP03130 
TAP03140 
TAP031“ 
TAP031 


[50 

[60 


iim 


200 

300 

310 

330 


FSCAN=1 

IFOST=l 

S’-STR=t 

*i(PITF{6.A81)  (FR..1(I,4)  .Isl,3)»NC#NS 

rf-<ITE  (6tb00)  IFWST,SMSTR 

RETURN 

format (*  unrecoverable  error  reading  header  PECOHD*) 

format (•  A LINE  NO,  IS  LESS  THAN  OR  EOUAL  ZERO*) 


LINE  read* 

dimensions 


format (•  last  scan 
format (/•  internal 

*S  ON  data  TARF=»,I7.»  no,  of 
3A0  FORMAT (•  CHFCK  THE  FOLLOWING 
*T  IN  requested  format*) 

360  format (*  ONLY  ONE  OH  LESS  RECORDS 
*IME*) 

370  FORMAT (*  NO,  OF  RECORDS  PER  DATA  SET 
•OUAL  15') 

390  FORMAT (•  NO,  OF  HITS/PIXEL** . I5» * ONLY 
•IMt*) 

400^FORMAT(*  DATA  ORDER  INDICATORS* . 15/*  DATA 

4B1  FORMATdH  ///•  INPUT  IMAGE  DATA  TAPE  INFORMATION*// 

* 5X» 'FORMAT* »T30t3A4/  • 

* SH,»:go.  OF  channels '♦T30*  14  / 

* SX.'NO.  OF  PIXELS/LINF*.T30.14) 

SOO  format (SX. 'FIRST  SCAN  LINE  NO,'  *T30*I4/ 

* 5X, 'FIRST  PIXEL  HEFEHENCt  PT . * t T30» 14) 

510  FOHmaT(1A4) 

END 


ISt*  ISTATs'.IS) 

TOO  SMALL  FOR  DATA*/* 
P01NTS/CHANNEL=* • 17/) 

POSSIBLE  ERRORS*/*  1.  DATA 

PER  Channel  acceptable  at  this 

ra**I5**  MUST  BE  LESS  THAN  OH 
8 BITS  acceptable  AT  THIS 
MUST  BE  ORDERED  BY 


TAP03170 
TAPO 
TAPO 
TAP03 
TAP03 
TAP03220 
TAP03230 
IAP0324Q 
TAP03250 
TAP03260 
TAP03270 
TAP03280 
TAP03290 
TAP03300 
TAP03310 
NO.  OF  CHANNELTAP03320 
TAP03330 
tape  IS  NOTAP03340 
TAP03350 
TTAP03360 
TAP03370 
ETAP03380 
TAP03390 
TTAP03400 
TAP03410 
PIXELTAP03420 
TAP03430 
TAR03440 
TAP03450 
TAP03460 
TAP03470 
TAP03480 
TAP03490 
TAP03500 
TAP03510 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


^7/ 


FILPS  WRTBMT 


SUBROUTINE  woT9MT(BMAT.N0FET4./40F£T2.FETVC2) 
niMFNSlON  CM|?» 

DATA  CH/*Cr1(  *f»  ) •/ 

INTEGER  FETvrPOft) 

C TNCLUnF  COMokg.LIST 

C0MM0N/6L0BaL/HEA0(63> .MAPTAPtOATAPEtSAVTAP.RMFlLEtPRKEY* 

* HlSFlL»HISKEY.THFORN,eMIPTPfE»PKEY.MAPUNT.NOFlLFt 

• n«IJMAD*0WM«0S»PAGSI^.nATFlL»STAFlLtA5AV»ASAVFL 

# ,NHSTI)N»NMSTF1.SCTHUN*HAPFIL  , 

• .n0TUNT,0nTFlL.t»'CHPAStTRNSFL»8MTRFLtHlSTFL»PCHUNT» 

* CR0UNTtPRTUNT»PAND10 

CSENO 

niMFNSlON  RmaT (N0FETA.N0FET2) 
nOUPLE  PRECISION  BMAT 
GO  TO  A 

FNTRY  WRTRM (PR“AT ,NOFET4,NOFET2»FETVC2) 

DIMENSION  flRMAT(N0FET4,N0FET2) 

K = 1 


CONTINUE 
WRITE (4.HE^^) 

WRITE (G. 100 )N0FET4.N0F£T2 

TPsl 

IK  = 1? 

S TFflK.GT.rJOFFT?)  IK=N0FET2 
WRTTF(f  ,2noXCH(l)  ,CH(2»  » lal 
,IrlR,l 


B«  IK) 
K) 


WRTTF(f^,3nO)  (FETVC2(I) 
write (G.3S0) 

IFtK.FO.O)  GO  TO  11 
no  1?  ,J=1,nOFET4 

12  WRTTE(*,,aoO  > J.  (BBMAT(Jf  I)  .IsIBfIK) 
GO  TO  13 
11  rONTlNUF 

00  10  .Jsl.NOFET* 

10  WRITE (A, 400 )J» (BnaTIJ, I) »I=IB»IK) 

IT  CONTINUE 

TE ( Ik.E0,N0FET2)G0  TO  20 
IR=IK*1 
IK=IK*12 
GO  TO  S 
?0  RFTURM 

100  FOOMAT (///45X. ILINEAH  TRANSFORMATION 

• SOX. 'NO.  linear  comb,  -».I3/ 

* SOX.iNO..  channels 

pnn  E0RMaT(/1?x.1?(A4,A4.2X) > 

300  FOOM!iTnH*,Ux,ll  (I2.AX)tI2) 

3G0  FORMAT ( IX. »LIN.  CMB.*) 

400  FORMAT ( IX. IS»4X.12( 1X.EP.3) ) 

END 


(B> 


MATRIX*// 


WRTOOOlO 

WRT00020 

WRT00030 

WRT00040 

WRTOOOSO 

WRT00060 

WRT00070 

WRTOOOSO 

WRT00090 

WRTOOlOO 

WPTOOnO 

WRT00120 

WRT00130 

WPT00140 

WRTOOISO 

WRTOOlOO 

I.RT00170 

WRTOOISO 

WWT00190 

WRT00200 

WRT00210 

WRT00220 

WRT00230 

WRT00240 


WRT00270 

wPT002«0 

WRT00290 

WRT00300 

WRT00310 

WRT00320 

WRT00330 

WPT003<»0 

KPT003S0 

wRT003*>0 

*>PT00370 

WRT003e0 

WRT00390 

WRT00400 

WRT00410 

WRT00420 

WRT00430 

WRT00440 

WRT00450 

WRT00460 

WRT00470 

WRT00480 


WRTOO 

WRTOO 


^7ctJ 


or»r>  non  nr»o  r»r»n  o r>  r»  <v>r»r» 


FTLFJ  WRTOOT 


nOTFIL  OUTPUTS  THE  DOT  DATA  FILE 

A file  is  created  fom  type  of  dots 


C 

C 


SUBROUTINE  WRTOOT(TOTnOT»NOSUN«FLDSAV.VEPTEX»ANGLE»OOTS«NOCATi 

• CATNAM»SlZE»NOFET2fFETVC2«TOTvT?»NOFLO?» 

* UNIT. FILE) 

IMPLICIT  INTEGER  (A-Z) 

OIMENSTON  CATNAM  i'NOCAT)  .FLDSAV  (A.  1 ) . VERTEX  (2.  1 ) .ANGLE  ( 1 ) 

DIMENSION  FETVC2(30) .nOTS(SlZE.TOTOOT) 

nOTFIL  » FILE 
nOTUNT  = UNIT 

POSITION  TO  DESIRED  FILE  - 

REWIND  OOTUNT 

CALL  FS8SFL(D0TUNT.D0TFIL.ISTaT) 

REC  NO.  1 — Indices  for  rec  no.  2 

WRITE(DOTUNT)NOCAT,NOFET2,NOFL02.TOTVT2.TOTOOT. NOSUN. (CATNAM (I) . 

* 1=1. NOCAT) .SIZE 

REC  NO.  2 

WRITE  (OOTUNT)  (FETVC2(I)  .1  = 1 .N0FET2).  ( (FLOSAVd.J)  .1  = 1.4)  .J«l. 

• N0FL02)  . ( ( VERTEX  ( I.  J)  .1*1.2)  .J*l.TOTVT2)  . (ANGLE  U ).  1 = 1 »^fOSUN) 

REC  NO.  3 DOT  DATA  INFO 

WRITE (OOTUNT) ( (DOTS(I.J) .I=1.SIZE) .J*l.TOTDOT) 

END  FIIE  DOTUNT 
RETURN 

FND 


WRTOOOIO 
WRT00020 
WRT00030 
WRT00040 
WHT0005Q 
WRT00060 
WRT00070 
KRT00080 
WRT00090 
WRTOOlOO 
WRTOOllO 
WRT00I2O 
WRT00130 
WRTO0140 
WRTOOISO 
WRTOOibO 
WRT00170 
WRTOOISO 
WRTOOIRO 
WRT00200 
WRTOOPIO 
WPT00220 
WRT00230 
WPT00240 
WRT002S0 
WRT002SO 
VRT00270 
WRTOOPSO 
WRT00290 
.IRTO03O0 
WPT00310 
WPT00320 
WRT00330 
WPT 00340 
WRT003S0 
WPT003G0 
WRT00370 
WRT003S0 
WRT00390 


FRF 


WRTFLO 


r* 

c* 

c* 


C11EN0 


10 

inn 

?no 

?sn 


«;UBROUTTKF  «-'OTFLD(FL0«;AViVERTEX.N0FL0.KeY»CLSNAM,SU«NAM) 

TmolICIT  1NTEGE»(A-2) 

DIMENSION  CLSNAM(I) ,SU0NAM(1) 

THIS  SU0BOUTINE  Points  saved  training  or  test  fields 

DIMENSION  FtOSAV(4,NOFLO) .VERTEX(2»1) 

DATA  LORN/i ( 1/ 

TNCLUDF  C0M3K6.LIST 

C0MM0N/GL0bAL/MEftn(63l »MAPTAPtDATAPE»SAVTAP»BMFILE»BMKEY. 

* HlSFlLtHlSKEY.TRFOHM.ERIPTP.ERPKEY.MAPUNTtNOFILE* 

» nHUMAD*flPMwns.PAGSl2»nATFIL»STAFIL»ASAV*ASAWFL 

» ,NHSTUN.nwSTFI,SCT»^UN,MAPFR  ■ . ^ 

» ,OOTUwT,OOTFlL.NCHPAS»TRNSFL»0MTRFLtMlSTFL»PCHUNTf 

► crount»pwtunt»rano:o 

IRsl  . . . . 

WRTTF (ft.HEAD) 

IF(KFY.F'3.1)VRITE(6»lnO) 

TF(KFy.FC3.2)«PITE(6»?00)  ■ • • 

IF (KFY.^E.3)wPITE <6.300) 

TF<KFY.r:iJ.3)WRITE  (6.2S0) 

DO  in  I=l.NOFLD  - 

NV=FL0S4V (4. I) 

NO=NV-l  . ...  . 

NP*N0-S 

TF<N0.GT.5)N'GI=5 

TE-IP+NO-1 

IC=FLDS4V(2.I) 

IS=FLDSaV(3.I» 

FLDNAM=fL0S6V(1 ,I) 

TF(KFY.wF.3)G0  to  S . 

WRTTF (6,700) I.FLDNAM, (LPRN, VERTEX ( 1 »J) . VERTEX! 2* J) .JsIB.IE) 
TFns.F'5.  1)MHITF.(6.70S) 

IF(1S.F0.2)>'RITE(6.710) 
r-0  TO  6 

5 rONTINUF 

IF(I5,FU,n)i-RITE(6.400)  I.FLONAM.IC.CLSNAMdC).  . . . 

* (LPRN.VFRTEXtl.J) .VERTEX ( 2. J) .JxIR.IF) 
IF(IS.NE.0)w«ITE(6.Snn) I .FLONAM* IC.CLSNAM ( R) . IS.SUBNAM (IS) « 

* (LPRN.VERTEX(l.J) »VERTEX(2«J) .J=10.IE) 

6 rOMTlNUE 

TF(NP.t  f ,0)GO  TO  7 

IR=IE*1 

IE  = IR♦^'w-l 

WRITF (6.6S0) (LPRN.VEHTEX(I.J) » VERTEX (2. J) .JxIB.IE) 

7 rONTTNliE 
TR=IF*? 
rOHTTNlJE 
RFTUWn 

FDPWAT(///  20X,«4RFA  used  to  COMPUTE  TRAINING  STATISTICS*/) 

FooMnT (///  ROx,*InpuT  fields*/) 

format  <///4RX. * designated  F IELDS* ///Tie. ‘FIELD *.TaO» ‘DESIGNATED* 
TFO.'vFRTir.ES  (Sample. LINE)  •/) 


300  format  ( 1 <•  TIh,  »FIE:lU*  .T34.  *CLASS*.T47.  ‘SUBCLASS'  .THO.  ‘VERT  ICFS 
•AMRLF.LIiNF)  •/)  » , 

400  format (TlS,T3.T?n,A4.T30.I3.T3S.A4.T65»5(Al. 

500  FOOM4T(T1S.T3.T?O.AA.T30.I3.T35» AA.TA5.13.t5 


IA.‘.‘.IA.‘)‘.1X)) 
50. AA.T65. 


* F(Al,I<..i,t,TA,‘)*.lX)) 

6«;0  FORMAT  ( U .T65.- (Al  , lA.  •,».  lA.  •)*.  IX)  ) 

700  format  (T1  5. 1 3.T2I).  A4.T6S.*>(  Al  . lA.  •»  *.  lA.  * ) •♦  IX)  ) 
705  FORMAT ( 1H..TA0. ‘UNIDFnTIFI ABLE* ) 

710  FORMAT ( 1H*.TaO. 'UTHEW* ) 

END 


aRTOOOIO 
WHT00020 
WPT00030 
WRTOOOAO 
WPT00050 
WRT00060 
WHT00070 
mMTOOOBO 
WRTOOORO 
mRTOOIOO 
WRTOOilO 
WRT00120 
WRT00130 
toPTOOlAO 
WRT00150 
WRT00160 
WRT00170 
kPTOOlBO 
WRT00190 
VRT00200 
WRTOOcMO 
VRT002P0 
V.kT00230 
WRT002AO 
WRT00250 
WRT00260 
WRT00270 
WRT002B0 
WRT00290 
WHT00300 
WRT00310 
WPT00320 
WRT00330 
VRT003A0 
WRT00350 
WRT00360 
WRT00370 
WPT003HO 
WRT00390 
WRTOOAno 
WHTOOAlO 
KPT00A20 
WRT00A30 
WPTOOAAO 
WRTOOASO 
VRT00A60 
WRT00A70 
WPTOOAfiO 
WRT00A90 
WHTOOSOO 
WRTOOSIO 
WPTOOS20 
. WRT00S30 
wrTOOSaO 
(SWRTOOS'iO 
WRTO0S60 
kRT00^70 
WWT005PO 
k'KT00S90 
►RT00600 
WRT00610 
ART00620 
WRT00630 
VHT006A0 


FILE  WRTHEO 


THE  PURPOSE  OF  TaPVRT  IS  TO  WRITE  A DATA  TAPE  IN  EITHER  UNIVER- 
SAL FORMAT  OR  LARSYS  II  FORMAT.  T«ER£  ARE  TWO  ENTRY  POINTS  TO 
THE  SUBROUTINE  — WRTHFO  ANO  WRTLN  . 

WRTHED  WRITES  THE  HEADER  RECORD  IN  32  BIT  BYTES  FOR  LARSYS  II 
AND  fl  HIT  HYTFS  FOR  UNIVERSAL.  ONE  CALL  TO  WRThED  MUST  BE  HADE 
FOR  EACH  REEL  OF  TAPE.  THIS  INFORMATION  IS  PACKED. 


C 

C**< 

C 


CALL  WRTHEOINC.EEAT.NSAMP.EORMAT.TRFORM) 


MC  , 
FEAT 
NSAMP 
FORMAT 
TRFORM 


FOR  EACH  DATA 
BE  WRITTEN 


SET 


WRTOOOIO 

SUBROUTINE  WRTHFO (NCHAN.FEAT.NSAMP.FRMAT.IUNIT)  WRT00020 

IMPLICIT  integer  (A-Z)  WRT00030 

CIWRT00050 
CIWRT00060 
CIWRT00070 
CIWHTOOOBO 
CIWRT00090 
CIWRTOOIOO 
CIWRTOOIIO 
CIWRT00120 
WRT00130 

ciwrtooIao 

CIWRT00150 
CIWRT00160 
CIWRT00170 
WRTOOieO 
CIWRT00190 
CIWPT00200 
CIWRT00210 
CIWRT00220 
CIWRT00230 
CIWRT002A0 
CIWRT00250 
CIWRT00260 
CIWRT00270 
CIWRT002B0 
CIWRT00290 
CIWRT00300 
CIWRT00310 
WRT00320 
CIWRT00330 
CIWRT00340 
CIWRT003S0 


NO. OF  CHANNELS  TO  BE  WRITTEN 
ARRAY  CONTAINING  CHANNELS  TO 
NO.  OF  samples  per  CHANNEL 
=1  FOR  UNIVERSAL 
NO.  OF  TAPE  OUTPUT  UNIT 
=2  FOR  LARSYS  II 
WRTLN  WRITES  THE  OaTA  IN  A BIT  BYTES  AND  IS  ALSO  PACKED.  A 
CALL  TO  This  routine  MUST  BE  MADE  FOR  EACH  DATA  SET  TO  BE  WRIT- 
TEN 


CALL 


WRTLN 

lOATA 

LSTLIN 


ICHAN 


(ioata.lstlin; 

— A“RAY  CONTAINING  DATA  TO  BE  WRITTEN 
~ a 0 FOR  N-1  OATA  SETS 
a-1  FOR  LAST  OATA  SET 


PROFLG 
CONTINUE 
NCS 

NBITS  — 

SVO 

NVF 

PRSZ 

NCPR 

NPrtC 

nhpos  — 
ANCLNG  — 
01)  I 

sahsth  — 
COYWRO  — 
NOSPH  — 
NCAP 

PACRAY  — DATA 
TAPE 


— ACTIVE  channels  have  CORRESPONDING  BIT  POSITION 
TURNED  ON 


NO.  OF  CHANNELS 
NO.  OF  BITS  PER  BYTE 
start  of  video  DATA 
S;iRF  AS  NSAMP 

Physical  record  size  in 
no,  channels  pep  record 
NO.  PHYICAL  records  per 
no.  OF  records  per  OATA 

LENGTH  OF  ANCILLARY  BLOCK 
OaTA  ORDER  INDICATOR 
sample  start 

SI7E  OF  computer  WORD  IN  BITS 
NO.  OF  DATA  SETS  PER  RECORD 


BYTES 
gHANNEL 
'IN  BYTES 


WRT00360 
WRT00370 
CIWRI003BO 


NO.  OF  CHArJNELS  ON  ANCILLARY  RECORD 
IS  packed  into  this  array  and  THEN  WRITTEN  ON 
_ BY  CALLING  NTRAN 
ICOUNT  — PUNNING  TOTAL  OF  NO.  OF  DATA  SETS  WRITTEN 


Cl 

Cl 

Cl 

»CI 


LOGICAL*!  PACRAY(3060) 

REAL  OAY<200» 

OImEnsION  NBUB)  .PACK(765» 

DIMENSION  IHYTFSI  If))  .EE  AT  1 30 ) , IRAY  (200) 

LOGICAL*!  VAHIAH(2AOO) 

COMMON  HLOCK  CHEATEO  AUG,  3.1979  TO  SAVE  LARSYS  III  HEADER 
COMMON  /lOST'tp/  IDD(250) 

COMMON  /WR  r AP/T  COUNT .EORMT .UNI T .VA»BL (600) « IREMO 
COMMON/TAPFR0/IUNIT7. I ERST, ESC  AN, S AMEND, SAM  INC. READY. 

I NSC  AN, L Inc, ID (200) , DSL ,L HUF ( 30 ) , JHEC ( 30 ) ♦ IHYTE (30) . 

? NPUFS.FILFNO.l 1NFND,L 1NINC,NSAMRZ,NCHAN7,F0RHTZ 
data  iHYTES/ftl  ,f 'J,  0 0,91  100. 102,103.104.105, 107. 10«.  no. 

• 7S3.177H,17flS,17H7/ 

data  NP/a, 1,1, !»?,?,£, 1,1,1,?, 1.2.?. 1,1. 2. 2/ 

EOUIVALENCE  (VA-'hL.VAHIAB)  , (RACK, PACRAY)  , (IRAY, RAY) 

FQillVALtNCE'  ( VARBL  ( 14)  .NOSAM) 


1 

2 

3. 

4 

5 

6 
7 


(VAOPl ()), ICHAN),  (VARHL(7) .PRSZ) . 
(VARf  L (2) , PROFLG) . (VAPRL(B) ,NCPR) . 

( VAPnl  ( T) ,NC) . ( VARML (R) ,NHWC) . 

(VAR-L(4) .NHITS) . (VAHHL(IO) .NRPDS) . 

( VARHL (S) ,svn)  , ( VARHL (11), ANCLNG) . 

(VAP4L(12) »D0I) , 


WRT00390 
_ WPT004O0 
CIWRT00410 
CIWRT00420 
CIWRT00430 
CiwRI 00440 
C1WPT00450 
CIWRT00460 
Cl  WRT00470 
WRT004BO 
WRT00490 
WRTOOSOO 
WRT00510 
WRT00620 
WRT00S30 
WRT00S40 
WPT00550 
WRT00S60 
WRT00S70 
WHTOOSBO 
WRT00590 
WRT00600 
WPT00610 
WRT00620 
WPT00630 
WRT00640 
WRT006SO 
WRT00660 
WPT00670 
WBT00680 
,W»r006R0 
WRT00700 
WWT00710 
WWTU0720 
(VAPHL(16) ,NDSPR) ,WHTnn730 
WHTO0740 

(VAPBL(17) ,NCAP) , WRT007S0 


(VARBL(IS) .COMWBO) 


( VAWGL  (6)  ,NVF)  . (VARHL(13)  tSAMSTR)  , (VARHLdB)  .NSAM)  WWT00760 


FILE  WRTHED 


C 

C 

C 


NC  ■ NCHAN 
FORMT  a FRMAT 
UNIT  * lUNIT 
ICOUNTaO 
SAMSTHal 
ICHAN  a 0 
ISTAT  aO 
NVF  s NSAMP 
NSAM  a NSANP 

NOSAM  a NSAMP  , 

IF  ( FORMT  *EO.  1)  60  TO  AO 

ZERO  OUT  header  RECORD  STORAGE 

DO  S Ial,200 
IRAY(I)  = 100(1) 

PACKING  HEADER  RECORD  IN  LARSYS  II  FORMAT 


AO 

50 


510 


(SO 

70 


75 


82 


IRAY(5)  =NC 
IRAY(6)  sNSAMP 


♦ 6 


NORYTE  = ROO 

CALL  WRTRFC(UNIT»NOBYTE»IRAY) 

RETURN 

packing  header  RECORD  IN  UNIVERSAL  FORMAT 


DO  50  1=  IfNC 

n a FEAT(I) 

ICHAN  = ICHAN  ♦ 
NPRC  s 0 
PROFLG  3 1 
N8ITS  3 8 
svn  3 1 
PRSZ  = 30(SO 

PRSZHD  3 3060 
ANCLNG  3 70 
ANC  3 ANCLNG  ♦ 2 
DOI  3 0 
COHWRO  3 32 
NOSPR  3 1 
NCPR  3 0 
IE  (NSAHR 
FORMAT  ( • 

IF  (NSAMP 


2**(32-II) 


,GT.  2R9A)  WRITE(6*510) 
NO.  OF  SAMPLES  WAS  RESET 
.6T.  2990)  NSAMP  s 2998 
iLt-'N  3 (NC*NSAMP)  ♦ ANC 
ILENTH  3 (NC*NSAMP  ♦ ANC  )/ 
IRFMD  3 ,.100(  (NC*NSAMP  ♦ ANC 
IE  (ILENTH  ,E0.  f')  NCAP  3 NC 


TO  2998*) 


3000 
) *3000) 


0) 

i>) 


NRPOS 
GO  TO 


.GT. 

.GT, 


76 


80 


85 


IE  (ILENTH  ,ED, 

IE  (ILENTH  ,EQ. 

DO  60  Jsl.NC 
IE( (MSAMP«J*ANC 
IE( (NSAMP*J*ANC 

continue 

CONTINUE 

NOCHAN  3 NC  - NCAR 
no  7S  Jsl, NOCHAN 

IF(NSAMP*J  ,OT.  2998) 
IF(NSAMP*J  ,GT.  2998) 
CONTINUE 
NCPH  3 NOCHAN 
CONTINUE 

NRPOS  3 NOCHAN  / NCPR 
IF  (MOD (NOCHAN. NCPR) 
CONTINUE 

IE  ( ILENTH. NE.O)  GO  TO 
P«SZ  3 ( ILFN/180) *180 
IF  (pPSZ.Nt.Il.FN)  PRSZ 
CONTINUE 

ZERO  OUT  PACPAY 

no  flS  Ksl,76S 
PACK(K)  3 0 


3 1 
80 

3000) 

30C0) 


NCAR  1 
GO  TO 


70 


NCPR  8 J-l 
GO  TO  76 


1 

.NE. 


0)  NRPOS  3 NRPDS  ♦ I 


82 

sPRSZ 


180 


WRT00770 
URT00780 
WRT00790 
WRT00800 
WRT00810 
WRT00820 
WRT00830 
WRT008A0 
WRT00850 
WRT00860 
WRT00870 
WRT00880 
WRT00890 
WRT00900 
WRT00910 
WRT00920 
WPT00930 
WRT009A0 
WRT00950 
WRT00960 
WRT0097Q 
WRT00980 
WRT00990 
WRTOIOOO 
WRTOIOIO 
WRT01020 
WRT01030 
WRT01040 
W.RT01050 
WRT01060 
WRT01070 
WRT01080 
WRT01090 
WRTOnOO 
WRTOlllO 
WRT0U2O 
WRT01130 
WRTOllAO 
WPT01150 
WRT01160 
WHT01170 
WRTOl 180 
WRT01190 
WRT01200 
WRT01210 
WRT01220 
WRT01230 
WRT012A0 
WRT01250 
WRT01260 
WRT01270 
WRT01280 
WRT01290 
WRT01300 
WRT01310 
WRT01320 
WRT01330 
WPT013A0 
WHT013S0 
WHT01360 
WWT01370 
WRT01380 
WPT01390 
WWTOIAOO 
WPI01410 
WPT01420 
WPT0H30 
WHT01440 
WHT01450 
WRT01460 
WPT01470 
WPT01480 
WPT01490 
WPTOISOO 
WRTOISIO 
WRTOlbZO 


9-7C 


FILE  WRTHEO 


DO  ion  K>1«18 
NBYTFS  = NM(K) 

00  90  L»1.NBYTES 

LOC  ■ 4 ♦ L - NBYTFS  ♦ (K-l)*4 

BYTE  a IBYTES(K> 

90  PACBAY(hJYTE»L-l)  a VARIAB(LOC) 
100  CONTINUE 

PACBAY(61)  a VA^!AB(73) 
PACPAY(62)  a VA9IAB(74) 
PAC0AY<6T)  a VAHIAfl(75» 
PACRAY(67)  a VA'^IAB(79) 
PACPAY(6H)  a VAHIAB(80) 

DO  no  L a 1,512 

:BAY(111  « L)  a VAPIABdll 


no 

120 


1,0 

€••• 

c*»* 

c 


PACf 


♦ u 


VARIAB(2200  * 


no  120  L a 1,16 
''ACBAY(2200  ♦ U a 
DO  130  I a 1,4 
I PAT  a 2254  ♦ (I  - 1)*8 
PACHAY(IPAT)  a VANIABdPAT) 


THE  ABOVE  THPEE  LINES  IS  AN  AO  HOC 
ADDED  OCT.  23,1978 

CALL  WRTPEC(UNIT,PPSZH0,PACRAY» 

RETURN 

END 


L) 

ADDITION  FOR  SOIL  LINES 


WRT01530 

WRT01540 

WRT015S0 

MRT01560 

WRT01570 

WRT01580 

WRT0iS90 

WRT01600 

WRT01610 

WRT01620 

WHT01630 

WRT01640 

WRT01650 

WRT01660 

WRT01670 

WRT01680 

WRT01690 

WRT01700 

WRT01710 

WRT01720 

WRT01730 

WRT01740 

WPT017S0 

WRT01760 

WPT01770 

WRT01780 


riLE  WRTLN 


SUBROUTINE  WRTLN(/I0ATA/«LSTL1N) 

IMPLICIT  INTF6FR  «A-Z> 

COMMON  /toPTAP/ICOUNT»FORMT»UNITtVARBL(«O0) *IR|MO 
logical*!  PACHAYinSOO)  f ISCAN(A)  tlOATAUt  tlRECNO 
LOrtiCAL*!  ZEWO(4> ♦C0NE(4) 

EQUIVALENCE  (LONEtlONE) 

DATA  IONE/ZFFFF/ 

(ICOUNTilSCAN) 

(RECnO.IRECNO) 

<ZF.mO»IZERO) 

(VAkhLO)  «NC)  « (VARRL(T)  *PRSZI  t 
(VARRL(«)  fNCPR)  . (VAWFIL(9»  .NPRC)  » 
(VAHML(IO) ,NRPDS) * (VAHPL(ll»  «ANCLNG)# 
(VAhhl(16) *NSAMP) t (VARBLIIT) tNCAR) 


(A) 


EOUIVALENCE 
EOU I valFNCE 

equivalence 

equivalence 


ICOUNT  ♦ 1 


ICOUNT  a 
iZFRO  » 0 
ANC  » ANCLNG  ♦ 2 
IF  (FORMT  .EO.  1) 


GO  TO  UO 


WRITES  PACKED  DATA  ON  TAPE  IN  LARSYS  II  FORMAT 


650 


FORMAT  015) 

packing  one 


SET  UF  DATA  INTO  ONE  RECORD 


NBITS  s 8 
ANCLNG  = A 

NPVTES  = (NSAMP  ♦ 6)»NC 
PAC«AY(\)  = ISCAN(3) 

■ I?.)  a TSCANIA) 


PACPAYd 
PACPAYO) 
PACRAY(A) 


a LONE (A) 
a lone (A) 


;•••  ADDED  AUG  10»1979  TO  ADD  CALIBRATION  SPACE 

IV  a 0 
III  a 0 

DO  120  II  a 1,NC 

no  110  I a l.NSAMP 

III  a III  ♦ 1 

IV  a IV  ♦ 1 

PACMAYdV  ♦ A)  a I0ATA(III*A) 

110  CONTINUE 

IV  a IV  ♦ 6 
120  CONTINUE 

NRYTES=NHYTFS» ANCLNG 
I01»M=(NM,YTFS/4)*A 
I lOUMaNNYTES-IOUM 

IF  { I IDUM.NF.  0)  N-iYTFSaNRYTES*4-I  lOUM 
CALL  WRTWECCUNITtNHYTES.PACRAY) 

IF  (LSTLIN  .EQ,  -1)  ENDFRE  UNIT 
RETURN 


118 


C 

C 

c 


i 

c. 


155 


WRITE  packed  DATA  ON  TAPE  IN  UNIVERSAL  FORMAT 

DO  150  1=1.7? 

PACRAY(I)  a ZERO(A) 

ROW  a 1 

NR  a NRPOS  - I 

IF(NCPR.EQ.O)  GO  TO  155 
NCLR  = MOO ( (NC-NCAR) fNCPR) 

WORD  = 73 

PACKING  ANCILLARY  INFORMATION  INTO  PACRAY 
PFCNO  a 1 

PACRAY(2)  a IHFCNO(A) 

PAC»AY(71)  = ISCANI3) 

PACRAY(72»  a ISCAN(4) 

DATA  15  NOT  PACKED  WITH  ANCILLARY  RECORD 


IF  (NCAR  .NE.  0) 
NRyTES  a NiAMP  * 
KA  a 1 
GO  TO  210 


NC 


GO  TO  160 


WRTOOOIO 
WRT00020 
wRTn0030 
WRT00040 
WRT00050 
WRT00060 
WRT00070 
WRT00080 
WRT00090 
WRTOOlOO 
WPTOOllO 
WRTOOllO 
WRT00130 
WRTOOUO 
WRTOOiSO 
WRT00160 
WRT00170 
WRT00180 
WRT00190 
WRT00200 
WRT00210 
WRT00220 
WRT00230 
WRT00240 
WRT00250 
WRT00260 
WRT00270 
WRT00280 
WRT00290 
WRT00300 
WRT00310 
WRT00320 
WRT00330 
WRT00340 
WRT003SO 
WRT00360 
WRT00370 
WRT003B0 
WRT00390 
WRT00400 
WRT00410 
WRT00420 
WRT00430 
WRT00440 
WRT00450 
WRT00460 
WRT00470 
WRT00480 
WRT00<.90 
WRTOObOO 
WRT00510 
WRT00520 
WRT00530 
WRT00540 
WRT00550 
WRT0OS6O 
WRT0OS7O 
WRT005BO 
WRT00590 
WRT00600 
WRT00610 
WRT00620 
WRT00630 
WRT00640 
WRT00650 
WRT00660 
WRT00(S70 
WRTOObBO 
WRTOOGRO 
WRT00700 
WBT00710 
WRTOO  720 
WPT00730 
WWTOOT'.O 
WBT007‘>0 
WRTOO  7hO 


i FILE  WRTLN 


lAO 

660 


200 

210 


21S 

220 


ALL  DATA  IS  PACKED  ON  ANCILLARY  RECORD 

IF  (NCAR  .NE.  NO  60  TO  170 

NBYTCS  « IREMD  - ANC 
KA  ■ 2 . 

GO  TO  210 

PART  OF  DATA  IS  PACKED  ON  ANCILLARY  RECORD 

NBYTES  » NCAR*NSAMP 
KA  a 3 
GO  TO  210 

DATA  IS  PACKED  ON  MORE  THAN  ONE  RECORD 

ANC  • 2 

WORD  > 3 

KA  >4 

J S 0 
J = J ♦ 1 

IF  ( J.GT.NR)  GO  TO  200 
WRITF<6»660)NR 
F0RMAT(*  NR».I5) 

RECNO  * RECNO  ♦ 1 
PACRAY(2)  s IRFCN0(4) 

NRYTFS  a NCPR  * NSAMP  « « « 

IF  (NCLR  .NEt  0 .AND.  J .EO.  NR)  NBYTES  ■ NCLR*NSAMP 
GO  TO  210 
CONTINUE 

IF  (LSTLIN  ,EO.  -1)  ENDFILE  UNIT 
RETURN 

IF  (NCAR  .FO.  0)  GO  TO  220 
II  = (ROW-1)  ♦NSA'tp«4 
no  215  I=1«NBYTES  . . 

PACRAY(>/0R0*I-1)  * I0ATA(4*1*I 
CALL  .vRT«EC(UNlT.PRS7tPAC«AY) 

IF  (KA  .NE.  4) 

IF  (KA  .EO.  4) 

GO  TO  (lH0.200tie0.lB5) *KA 
END 


I) 

ROW  s NCAR  • ROW 
ROW  a ROW  ♦ NCPR 


WRT00770 
WRT00780 
WRT00790 
WRT00800 
WRTOOBiO 
WRT00H20 
WRTOOB30 
WRT00840 
WRTOOeSO 
WRT00B60 
WRT00A70 
WRT0OB8O 
WPT008RO 
WRTOOROO 
WRT00910 
WRT00920 
WRT00930 
WRT00940 
WRT00950 
WRT00960 
WRT00970 
WRT00980 
WRTOf ‘ 
WRTOj 
WRTOi 
WRTOI 
WRTOI 
WPT0I040 
WRTOiOSO 
WRTOiOGO 
WPT01070 


WRTO] 

WRTO 

WHTO 

WRTO 

WRTO 


080 

090 

100 

110 

20 


WRT01130 
WRTC1140 
WRT01150 
WRTOi 160 


06 


PILFt  WRTMTX 


SUBROUTINE  WRTMTX(MATICE»SIZEtBCO)  WPTOOOlO 

C WPT00020 

implicit  integer  tA-H,0-Z)  WRT00030 

C WRTOOOaO 

ntMENSION  FORMAT (6)  WHTOOOSO 

REAL  HATICEU)  KRT00060 

C|._— —————IWRTOOOTO 

Cl——— — — — — 1 '.kT  OOOflO 

Cl  iwRT00090 

Cl  CALL..  CALL  WRTMTX(MATICE.SIZ£»FREG.BC0.MAXFET»  IWRTOOIOO 

Cl  ' IWRTOOno 

ARGs..  maticf  - covariance  MATRICE  1WRT001|0 

SIZE  - rank  of  ’MATRICE*  (’OMATIC*)  IWRTOOISO 

F»FO  - FREQUENCY  MATRIX  iWRTOOlAO 

Cl  BCD  - contains  BCD  PRECISION  FOR  PRINTOUT  fwRTOOjSO 

CT  maXFET  - NUMBER  OF  FEATURES  PER  LINE  1WRT00160 

CT  IVRT00170 

Cl  REQUIRES.  NONE  IwrTOOIBO 

Cr  I»RT00190 

Cl  PURPOSE..  PRINTS  ThE  SINGLE-PRECISION  COVARIANCE  MATRICES  IWRT00200 

Cl  IWPT00210 

ri  RETURNS,.  NO  CHANGE  1WRT00220 

Cl  I'<RT00230 

Cl  — — — _ - — 

ri  IWWT00260 

Cl  CALL..  call  DWRTMX(MATlCE»SIZEiFREG»BCOfMAXFET)  lwRT00270 

Cl  IWRT002A0 

Cl  ARCS..  SEE  ABOVE  IWHT00290 

Cl  IWPT00300 

Cl  PURPOSE..  PRINTS  THE  DOUBLE-PRECISION  COVARIANCE  MATRICES  fwRTOOSlO 

Cl  I.BT00320 

Cl  RETURNS..  SEE  ABOVE  . IwRT00330 

Cl  IVRT00340 

CT lWHTOf>3SO 

Cl I'VRT00360 

C WRT00370 

C WkT003fl0 

C WRT00390 

C — — i — — WRTOOAOO 

C wkTOOAlO 

DATA  format/’ (IMO',', NX, '*»12F9*»’.  »»')  •/  WHTOOA^O 

nouPRE  = 0 WRT00430 

GO  TOlO  WRT004A0 

ENTRY  n.RTHX(DMATlC, SIZE, BCD)  WRT004S0 

nODPLE  PRECISION  DMATIC(I)  1.RT00460 

nO'iP'^Frl  WRT00470 

10  FORMAT (S) =PCO  WPT004G0 

00  100  L0C*1,SIZE,12  WRT00490 

STOP  = LOC*n  WRT00500 

TF  ( STOP  .GT.  SIZE)  STOP  » SIZE  WRTOOSIO 

TI  =1  WPT00520 

KING  a 1 WPT00530 

no  RO  IsLGC.SIZE  WRT00S40 

M r I*(I,l)/?-II*l  VHT00550 

.IK  = K*KInC-1  WPT00560 

IFIDOUPRE .EO.O)  WRITE I6.F0RMAT)  (MATICE < J) , J»K, JK)  WPTOObTO 

TF  (nOilRRE.EO.l ) WRI TE ( 6,E0RmaT ) (OMAT I C « J) , J»K, JK)  WPTOObAO 

JI  s IJ,)  kRTOOSPO 

OO  IF(KltJC.LT.lP.AND.KlNC.LT.STOP)KlNC»KINC*l  WRT00600 

mOTTF(0,1004)  wPTOOhlO 

ino  CONTINUE  WPT00b20 

1004  F0OMAT(*0*)  4PT00630 

RETURN  WPT00640 

C WhTO0650 

C WWTOObGO 

r - — — — wFTOOfoTO 

C * VPTOObrtO 

cup  WHT00fe90 


FILE  WRTRCC 


OUTPUTS  A SCAN  LINE  OF  DATA 


ION  Iflyn 3000) 


CiSf«*i‘uN0,H/4 

WP  t TE 16  f 20  0 1 UN  I T « LENGTh!  1 BUM  f 8)  * 


III 


format (/ 
format (3 

RETURN 
END 


ifir 

C2S0AA)) 


WRTOOO 
WRTOOOr 
)tRT0003< 
MRTOf 
WRT0( 
WRT0006( 
URTOO07C 
WRT0008Q 
WRT00090 
WRTOO  .00 
WRTOO  10 
WRTOO  20 


WRTO( 


Uff 


20.  DAMRG  PROCESSOR 


riLE  DAMRG 


SUMWOUTlNf  DAMRG (ARRAY. TOP) 

IMPLICIT  iNTEGtHr  (A-Z) 

R|Ar  SUNCOP.OtiM 

LOr,fCAL*T  lOl  (^iOO)  .VARlAB(2*.ftO)  .L0GSUNO2) 
POUIVALCnCE  (lU.IOl.)  * (VAHdi  .VAPIAbt  , (SUNANG.LOG 
C0MM0N/GL0»»L/H£An(ft3) «M*PT4P.0ATAPE.SAVT AP.HMf 
HlfPlL.HTSKFV.TKrnPH.tKlRTP.FHPKEY.MAPDNT.NOFIL 
DwOMAU.OwMwOS.PAftSIZ.OATrlL.STAFILf ASAV.ASAVKL* 


#nwuM4U.OwM>.os»PAftSiz»oATr 
•NHSTlIN.NMSTr  I .SCTPON.MAPF 
•OOTi  InT  . DOTF  It  t NChP  A $ . TPNS 


.BMKEY* 


•pmtrfl.histfl.pcmunt. 


•CPOMnT .PPTUMT .mamOTO 

CO'^'-ON/T  Apf.wo/ 1 1 IN  I T . IFPST  .FSC  AN  ♦ SAMFnO  .SAM  INC  .PE  ADY  .NSCAN  • 
•LlNC.IO(Ppn)  .OSL.LB'JFOo)  .JkFC(30)  .IHYTt  ( JO)  .NRUFS.FILENO.LI 
•LI'^'ImC.nSAmp.mocman.FOPmT 
COHMON/W-'TAP/lCOilMT.OUMMY.tJNIT.VARRL(600)  .IPEMD 

cnMM0N/isoLNK/«iUNANG(8) . isu n . isunc.smstp.sminc.lInskp 

COMHON/MPGOAT/lMnOT.ISOPT.NUMFlL.IDATTPift) .II)ATFL(6) . 
•MOFFAT. NFEAT  (A.)  .FETVF.C(30.iS>  «lSUN<a.A)  .SJNCOPOOT. 

•FLUINF  <^.*.). NOS AMP, noline »NSS( 6) .NACHOS.NLINES (6) .LINPTR(7) . 


?pI|m?nB.lInskp 

(6)  .II)ATFL(6). 


•LINKS (POP) .FOPMM 
dimension  apkAV(I) 

CALL  StTl«(ARRAY,TOP) 

MAJOR  LOOP  ON  FILES 

SwITCfi«0 
Nl  ■ 0 

tpppp  K 0 

ICCT  » 0 

iSo  700  I « l.NUMFIt 
IFd.fO.P.ANn.SxiITCH.EO.DGO  TO  80 

CALL  tape  header  read  PROGRAM  WITH  UNIT  AND  FILE 

TDaTII  ■ lOATTP(l) 

IOaTF  « tr)ATFL(I)  - 1 
CALL  TAPHOP(IOaTU.IUATF) 

CODE  Aunpn  TO  PEfORMAT  LANOSAT  III  INTO  LARSyS  OR  UNIVERSAL 
DAMOO  FDm  LANDSAT  III  StOlltNTlAL  FORMAT  IS  A SIMPLE 
channel  CHANNf-L  MERGE  OF  T*0  E ILES  . 

DAMPr,  FOR  LANOSAT  III  interleaved  FORMAT  IS  FORCED 
TO  LOOK  (.iKt  A SPATIAL  MtWi»E  OF  1 FltLD  ACROSS  AND  1 OR  2 C 
ONLY  A wtfOPMaT  CAN  ME  DONE  FOR  iNTtHLEAVEO  NO  MERGE  IS 
POSSIbLF  UNTIL  THF  REFORMAT  IS  COMPLETE 

IF  (FORmT  .tO.A.  and.  JREC  ( 1 > .t(5.  I ) SVITCM»l 
IF  (SRlTCH.FO.n)r.O  TO  100 
N0F«:  4T»NFEAT  (1) 

NACPOS»l 

IMOPT*? 

FLDSTP=FL0IMF(1,1) 

FLI)I.ST«F1.0InF(2,1) 

1F(FLD1NF(1,1),lE.1AV1)GO  to  so 

FIELD  ENTIRELY  ON  SECOND  TAPE 

FLOIriFd  .l)=FL0INF(l.n-l491 
FLDInF (2.1) *FL0 INF (2,1) -1491 
NtiMFlL*) 

GO  TO  80 

IF(FLUlNF(2,n  .!  E,14R1)G0  TO  75 

field  oveplaps  both  tapes 


2 DOWN 


FLDIN)-  (2.2)=FLDINF(2,1)-I4'ill 
FLOIM^  (2,  n*l4pJ-M0D(  (lA'Yl-FLOINFd  ,1)  ) .ELOINF  ('J.  1 ) ) 
FLDInF (1 ,?)sFl  OINr(2, 1 ) ‘FlUInF (3, J )-149I 
FLOInF  n,2)sFL01NF  (3.1  ) 

NSS (2) *NSS( 1 ) 

NLlNFSd)=(rLl>lMF(2,n-FLOlNFd.l)  ) /FLOl  NF  ( 3 , 1 ) ♦ 1 
NL1NES(2) =(FLDINF (2,2)-FLD1nF (1,2) )/FLUInF(3.2) ♦! 

GO  TO  100 

FI  FLO  ENTIRELY  ON  FIRST  TAPE 


)Am0004( 


LINEND. 


DAMOPieo 

0AM00390 

DAM00400 

DAM00410 

OAM00420 

0AHU0430 

OAH00440 

OAM00450 

DAM00460 

DAM00470 

BAM00480 
AM00490 
DAM0P500 
OAMOOSIO 
5am00520 
OAM00530 
OAM00S40 
QAM00550 
OAMOn5(SO 
OAMOOS70 
DAH00580 
DAM0nS90 
UAMUObOO 
DAM00610 
OAH00b20 
DAM00630 
OAM00640 
DAM00650 
DAMU0460 
DAH00670 
OAMOObBO 
DAM00b90 
DAM00700 
OAMOOdO 
DAM00720 
DAM00730 
OAMU0740 
DAM007S0 
DAM00760 


riLC  0AMA6 


C 

?5 

r 

AO 

90 

noo 

r*ft* 

100 

r 

r»** 

r 

r 

C 


r 

r*** 

r 

r 

r«*# 


r 


channels  FOH  this  FILC 


1060 

1070 

lOAO 
I OPS 

r 

r*** 

r 

1090 


r*** 

r 


NUMFIL"! 

GO  TO  100 

f>H0CESSlN6  SCCONO  FILE  FOR  LARSYS  III  INTERLCAVCO 

lUNlT«inATTP(2»  . 
REaO(IIINIT.I100»FNO>100>DUMMY 
•fOWMAT(lAA» 

GO  TO  9Q 

number  of 
NF  « NFEATm 

CALL  FLniNTIFLniNFdtl)  .FETYECI1«I).nF} 

SET  FEATURE  COUNTER 

IF(I.GT.l)  N1  » N1  ♦ NFEATd  - 1) 

SET  SCALAR  FIELD  DESCRIPTION  FOR  THIS  FILE 

SAmSTR  * FLD1NF(4.I) 

SamInC  a FLi)jNF  (6,  i ) 

SAM^iJO  « FLf>INF(S.I» 

LlNST-  s FL01NF(1.I» 

LlNl-JC  « FLOlNF(.ltl) 

LlNtNI)  * FL01NF(?.I> 

NO.  SAmRlES/LINE  for  file  I COMPUTED  IN  FLDINT 
NS  » NSAMP 

total  NUMBER  OF  radiance  VALUES  PER  *NE 
NV  a NS  * NF 

-RITE  FIELD  INFORMATION  FOR  FILE  I 

IF<S  .'ITCH.Fo.i.AND.I.EO.ZlGO  TO  1090 
WRITE  (PPTUNT.  10f,0)  I 
fOi-MAT{»()  INPUT  FI 

WRITE  (RRTIINT.  lO70> 

FOR'IATCO  START  LINE  EnD  LINE 

♦PiKi-L  PIXEL  INC) 


ELO  description  FOR  FILE'.IO) 

LINE  INC  START  PIXEL 


ENO 


IFiS^ITCH.fO.DUO  TO  10A5 
WRITE  (RRTUnT.  lOHO)  (FLOInFU.D*  JbI*6) 

FOR-*AT(»0  • .6  (4X.  I4.4X)  ) 

GO  TO  lONO 

WRITE (PRTUnT,10HO)FLOSTR.FLOLST»|FLDINF( J.l ) ,Js3,b) 
STORE  SUN  angles 


IF  ( !<;')NT.NE.n)00  TO  610 
iF(lS(INC.EO.O)GO  TO  620 

SUN  angles  from  CAROS 


00  600  J » |,fl 
IlXlh  • J)  a ISUNU.I) 

SUUANuIJ)  a I SUN (J.l) 

600  continue 

GO  TO  6^0 

r 

0#*»  SUN  angles  from  tape  header 
r 

610  no  MS  .)  a 1.8* 

ISO J( J.l)  a CUNANG(J) 

61 S continue 

CALL  SUNF  AC(SUNC0R.SUNANG.FETVEC (1 . 1) »NF. ISUNT, I5UNC) 

6?0  CONTINUE 

IE  (F'lRMM.Mr.n  GO  TO  660 
ww  1 T(-  ( Pw  T ll"'!  . ) iMlO  ) I 

1000  EOR'^AT  ( »OOATA  FOR  INPUT  FIIF».I4) 

WRITE  (PrTUoT. 1 01 C) lOL ( 100) . lUL ( 104) .lOL ( 108) .lOL (1  in  «10L ( i 1?) 
lOlO  format  ( lOlNP'jT  FllE  UATt  AOO  S I TE  •«  S ( 3X  » Z2)  ) 

r*»«  LOAD  vARjAO  wITh  Extra  heauer  information 


OAM0077I 
DAM0Q78( 
OAM0079( 
DAM006 
OAMooa.. 
DAMOOSIQ 
0AM00B30 
DAMOOH60 
OAMO08S0 


OAMO0B9O 

DAM0C9QQ 

damoorIo 

OAM00920 

OAM00930 

DAM00940 

DAMOOVSO 

OAMQ096Q 

6am!10970 

DAM00980 

DAMQP990 

OAMOlopp 

DAMOlOlO 

OAM0I020 

OAM01Q3Q 

DAM01046 

DAMOIOSO 

OAH01060 

OAM01070 

gAMOlOSO 
AMU1090 
OAHOliOO 

damoiHo 

OAM01140 

DAMoiiso 

OAM0l)6O 

OAM01170 

oamouho 

DAMOllRO 

damoi2oo 
DAM01210 
DAM01220 
DAM01230 
DAM01240 
DAM01250 
OAM01260 
OAM01270 
0AM0i280 
DAH01290 
DAM01300 
OAH01310 
DAM01320 
OAM0133O 
OAMOl 340 
DAMU1350 
OAMOl 360 
OAM01370 
OAM0138O 
OAM01390 
OAM01400 
OAM01410 
OAM01420 
OamO 1430 
DAMU1440 
DApO 1450 
DAM01460 
OAM01470 
D4MU1480 
OAMO 1490 
OAM01500 
OAMOlSiO 
UAM0I520 


file  oamrg 


r 

c*«* 

c 


load  date  and  site  from  first  file 


r. 

r««» 

c«** 

r 

625 


TO  625 

lOL(lOO) 

I0L(ln4> 

lOLdOS) 

inmii) 

I0L(112) 


650 


655 

660 

r 

c*** 

c 

r 

c 

C 


661 

666 


66? 

663 

C 

C#** 

C 


r 

c*** 

c 


TFCI.NF.DGO 
VA^IAB(73)  a 
VA-^IAM(74)  X 
V*«IAH(75)  X 
VARIAS(7«»)  X 
VAMlABtHO)  X 

FOrt  PUi»P0SES  OF  UNIVERSAL  HEADER  WRITE  LOAD  VAHlAB  WITH  SUN 
AND  GAINS  AND  BIASES  ONLY  U CHANNEL  MERGE  OPTION 

TF(l«OMT.NE,l)GO  TO  660 

no  650  J X i,nf 

lUHM  X <FETVECCJ,1)  - 1»  * 2 

11  = 112  ♦ lOOM 

12  = 112  ♦ N1  * 2 ♦ (J  - 11  * 2 

VA-^IA5(I2)  X IIX.(11  ♦ 3)  , 

VARlA^d?  ♦ 1)  X lOLdl  • 4) 

II  = 240  ♦ lOUM 

I?  X 240  • N1  • 2 ♦ U - 1»  * 2 
VA«lABd2>  = lOLdl  ♦ 3» 

VAf^lAHCI^  ♦ 1)  X lOLdl  ♦ 4J 

11  X 366  ♦ inUM 

12  X 368  * Ml  * ? ♦ (J  - 11  * 2 
VA-?IAM(I?I  X lOLdl  ♦ 31 
VA-<IA5d2  * 1)  X lOLdl  ♦4) 

11  = i»96  * inuM 

12  = 4Sr6  * Nl  * 2 »(J  - 1>  * 2 
VA-^IflSd?)  X lOLdl  *3) 

VABlAy{I2  ♦ U X IDLdl  ♦ 4» 
continue 

KS  X 0 

no  6S5  J X i,nf 

lO'JM  = FKTVEC(J»I) 

lUUN  X (inUM  - 1)  / NCHPAS 

IF(ISUUT.FO.II.AND.J.EO.I)  KS  x IQUM 

11  X (IDiJM  - KS)  *4*3 

12  X 2201  ♦ (Nl  ♦ J - 1)  ♦ 2 
VARlAy(l2)  X LOGS' iNdl) 

VARIA6(I2  ♦ 1)  X LOGSUNdl  ♦ 1) 

continue 

CONTINUE 

THE  NEXT  LINE  WAS  ADDED  OCT.  23*1978  AS  AN  AO  HOC  ADDITION 
TO  ADO  SOIL  LINES  TO  TmE  UNIVERSAL  HEADER 

VARIAB(2246  ♦ 8*1)  = TDL(640) 

INITIALIZATION  FOR  LINE  EXTRACTION  PARAMETERS  NEEDED  FOR 
SPATIAL  MERGE 

LOC  X d - 1)  / NACROS 
NS  X 0 

IF  (LOC.EQ.O)  GO  TO  666 
on  661  J X 1»L0C 
N5  X N5  ♦ NLINES(J) 

CONTINUE 

LREM  X (I  - 1)  - LOC  * NACROS 

N2  X 0 

IF (LREM.EO.n)GO  TO  663  . 

on  662  J X l.LREM 
M2  X N2  ♦ NSStJl 

continue 
ICT  X 0 

parameters  NEEDED  IF  PSEUOO  MERGE  OPTION 

LPTP  X LTNPTR(I) 

NL  X NLlNFS(I) 

NLM  X NL  ♦ LPTR  - 1 

EXTRACT  FIELD  FOk  THIS  FILE  LINE  8Y  LINE 


OAH01530 
OAMOI540 
OAMOISSO 
nAM01560 
OAHOiSTO 
OAMOISSO 
OAM01590 
0AM0I600 
OAM016lO 
0AM01620 
AN6LESOAM0I630 
OAMC1640 
OAH01650 
0AM01660 
DAM01670 
OAM01680 
DAH01690 
OAM0|700 
OAM01710 
0AM01720 
OAM01730 
OAH01740 
OAMOITSO 
0AMQ1760 
DAM01770 
OAM017B0 
DAH0I79G 
DAMOISOO 
D AMO  1810 
'3AM01620 
DAM01830 
0AM0I840 
0AM0185C 
DAM01860 
DAM01870 
OAM0188O 
0AM0I890 
OAM01900 
OAM01910 
OAH01920 
DAM01930 
DAM01940 
OAM0I95O 
0AM01960 
DAM01970 
DAM01980 
OAM01990 
DAM02000 
OAM02010 
OAH02020 
OAM02030 
OAM02040 
OAM02050 
DAM02060 
DAM02070 
OAM02080 
DtM02090 
OAM02100 
DAM02110 
OAM02120 
OAM02130 
OAM02140 
DAM02150 
DAM02160 
0AM02170 
OAM02180 
DAMC2190 
DAM02200 
0AM02210 
OAM02220 
OAM02230 
OAM02240 
DAM02250 
OAM02260 
DAM02270 
DAM02280 


2jO*^ 


FILE  DAMRG 


C 

r*** 

c 


665 

670 

C 

1020 

r 

c*** 

c 

r 

c*** 

r 


671 

67? 


675 

r 

(•*•• 

C 


676 

677 


679 


C 

r 

660 


6«1 

6ft? 

69P 

r 

f*** 

c 

700 

r 

r*** 

c 

r#*« 

C 

r. 


00  690 
ICT  * I 


^1*1 


LINSTP«LINEN0«L1NINC 


,ALL  LINEPD(ABRAY(1) .ENOTAP) 
[F  Tenotap.eo.-i)  CMEPR 


IF<IM0PT.N£.3)60  to  6 

LOOK  FOR  LlMF  MATCH  IF  PSEUOO  MERGE 

no  665  J = lptp.mlm 

IF n I. to, LINES IJ) ) GO  TO  670 

continue 

GO  TO  690 

CONTINUE 

ICCT  = ICCT  ♦ 1 

IF ( IPPPP.CO. 1 ) WRITE (PRTUNT« 1020) (ARRAY (K) vKsl tNV) 
FommaT(/10I7) 

IMr40PT.NE.l)60  TO  675 

channel  merge  mode  write  Nv  values  TO  DIRECT  ACCESS  FILE 
IF(ISOPT.EO.O)GO  TO  672 
00  SUN  angle  CORRECTION 


on  671  J = 1,NF 

no  671  JJ  = 1*NS 

ITEMP  = (JJ  ♦ (J  - 1)  * nS) 

nu«  ^ SUNCOR(J)  * FLOAT (ARRAY ( ITEMP) ) 

ARPAY(ITEmP)  = IFIX(OUM) 

CONTINUE 

AODkES  = ORUMAn  ♦ N1*NS  ♦ (ICT  - 1)*NS«N0FEAT 
call  R*WITE (ADORES. array (1) ♦NVfSTATUS) 

GO  TO  690 

IF(ImOPT.NE.?)GO  to  680 


spatial  merge  mode  write  NSS(I)*NF  values  to  direct  access  FILE 


IF(!SOPT.EO.O)GO  to  677 

DO  676  J = l.NF 

no  676  JJ  = l.NS 

ITEMP  = (JJ  ♦ (J  - 1)  * NS) 

nUM  = SUNCOR(J)  • FLOAT ( array ( ITEMP) ) 

ARRAY (ITEMP)  = IFIX(DUM) 

CONTINUE 

N4  = NSS(I) 

00  679  J=1.NF 

AOnPES  =ORUMAD  *(N5  ♦ ICT-1 ) *NOSAMP*NF*NOSAMP* ( J-1 ) .NZ 
ITEMP  = 1 4 (J-1)*N6 

CAUL  PWHITE(ADDR£S. ARRAY (ITEMP) .N6.STATUS) 

continue 

GO  TO  69o 


PSEUDO  merge  OPTION 

IF (ISOPT.FO.n)GO  TO  682 

no  6ftl  J = l.NF 

00  6ftl  JJ  = l.NS 

ITEMP  = ( JJ  ♦ ( J - 1)  * NS) 

OUM  = StlNCORiJ)  * FL0AT(AHRAY(ITEMP)  ) 
AWRAY(ITEmR)  = IFIX(OUM) 

CONTINUE 

ADORES  = ORUMAf)  ♦ (ICCT  - 1)  * NV 
call  O 'RITE (ADORES. array (1) .NV.STATUS) 
CONTINUE 

line  LOOP  complete 
CONTINUE 

LOOP  FOR  FILE  1 complete 

write  output  file 

OATFI  = DATFIL  - 1 


OAM02290 

DAM02300 

OAM02310 

OAM0232O 

OAM02330 

OAM02340 

OAM02350 

OAM02360 

OAM02370 

OAM02380 

DAM02390 

OAM02400 

OAM02A10 

OAM02A20 

UAM02630 

OAM024AO 

DAM02A50 

DAM02A60 

OAM02470 

OAM02680 

OAM02690 

OAM02500 

OAH025IO 

OAM02520 

DAM02530 

OAM02540 

0AM02550 

DAM02560 

OAM02570 

OAM02580 

OAM02590 

OAM02600 

DAM02610 

DAM02620 

0AM0263G 

0AM02660 

DA'-I02650 

OAM02660 

DAM02670 

0AM02680 

OAM02690 

OAM02700 

DAM02710 

OAM02720 

OAM02730 

DAM02760 

OAM02750 

0AM02760 

DAM02770 

OAM02780 

DAM02790 

0AM02800 

DAM028I0 

OAM02820 

OAM02830 

OAM02840 

DAM02850 

DAM02860 

DAM02870 

DAM02880 

DAM02890 

OAM02900 

OAM02910 

DAM02V20 

OAM02N30 

UAM02940 

DAM02950 

DAM02960 

OAM02970 

DAm029i^0 

OAM02990 

OAM03000 

OAM03010 

DAM03020 

DAM03030 

OAM03040 


FILE  0AMR6 


r**» 

POST  1 'JN  OUTPUT  FILE 

DAM03050 

c 

OAM03060 

> WIMO  OATAPE 

DAM03070 

CALL  FSFmFHDATAPE«DATFI»1STAT) 

DAM03080 

r 

OAM03090 

c*** 

SET  OUTPUT  channels  NOFEAT 

dAH63i00 

c 

OAM03liO 

00  «f)0  I » 1. NOFEAT 

DAM03120 

FETWECdtll  s I 

OAM03130 

fton 

continue 

OAM03lA0 

r 

OAMOilSO 

r*** 

WRITE  HEADER  OF  OUTPUT  FILE 

OAM03160 

c 

OAM03170 

CALL  wRTH£0<N0FEAT.FETVECC1 tl) ,NOSAMP*FORMMfOATAPE) 

OAM031U0 

r 

DAM03190 

c*** 

EXTRACT  SCAN  LINES  ONE  AT  A TIME  WRITE  TO  OUTPUT  FILE 

OAM03200 

0AM03210 

LSTLIN  = 0 

OAM03220 

NV  = ^40SAMP  * nOFEAT 

OAM03230 

no  350  I = 1. NOLINE 

OAM03240 

IF(I.EQ.N0LINE)LSTLIN  = - 1 

OAM03250 

ADORES  = DRURA'J  ♦ <I  - 1)  * NV 

OAM03260 

CALL  RREAn(AODRES»ARRAY(l) »NV*ISTAT) 

DAMU3270 

CALL  wmTLN( ARRAY (1). LSTLIN) 

DAM03280 

TF<IPPPM.FO.I)-*RITF(PRTUNT,1030)  I 

OAM03290 

1030 

format  ( •OOUTPItT  LINE*»I6) 

OAM03300 

IF ( IPPPP.EO.l ) PRITE (PWTUNT.1020) ( ARRAY (K) tKsl«NV) 

DAMU3310 

HSO 

continue 

DAM03320 

c 

DAM03330 

RETURN  TO  MONTOR 

OAM03340 

c 

DAM03350 

r 

OA'»03360 

OUTPUT  file  completed 

DAM03370 

r 

OAM03380 

RETURN 

DAM03390 

END 

OAM03400 

nnn  nnn 


FILFS  SETIB 


C 

C*** 

c 


SUPPOUTl^F  SKT1<M*«RAY.T0P) 
implicit  INTfGPy  (A-?) 

r0MM0N/(?L0bAL/«EAn(f3) .MAPTAP,0ATAPE«SAVTAP.8MF1LE»BMKEY« 
*Ml<5FlL,HlSKFY,TWF0RM,tRIPTP*FPPKEY»MAPUNT,N0FlLE. 
•n6iNAD.0PM*ns,PAGSlZtnAtFIL«STAFlLfASAV»ASAVFL* 
•NH«:TUN.^^MSTFI,SCTPU^4,MAPFIL* 

•nOTUNT.nOTFII.*K‘CHPAS.T«NSFL»PMTRFL»HlSTFL»PXHUNT, 

•CPOUM  « PH  TUNT  * RAND  1 0 

COMMON/TAPERO/IUNIT  t IFPST,FSCAN,SAMENn»SAMINC.REiOY»NSCAN» 
*LlNC.in(200)  tDSL.LwUFnO)  .JRECOO)  ♦IRYTEOO)  tNRUFSfPILENOtLINEND. 
•I  lNINC.NSa'*‘’*NOCHAN»FORMT 
COMPON/wRT  AP/ 1 COUNT . DUMMY , UN I T » V ARBL (600). IREMO 
COMMON/ I SOLNn/SUNANG(H) . ISUNT* ISUNC . SM5TR .SMINC »L INSKP 
COmmON/mRGC)  AI/ImoPT  . ISOPT  ,NUMF  1L.  IOATTP  (6)  . IDATFL  (6)  » 
•NOFFAT.NFEAT  (G)  »FETVEC(.in»6)  »1SUN(8.6)  .SUNCOROOl  « 

*FL0INF(6.6) .NOSAMP.NOLINE.NSS (6) . MACROS. NL INFS (6) »LINPTR(7) • 
•LINFS (600) .FOHMH 
DIMENSION  APRAY(l) 

dimension  HFDl  (IS)  .HE02(1S)  .DATEO)  .COMENTdS)  .EOUVEC  (2)  .SL  ASH  ( 2) 
FOOT valence  (HFDl .HEAD (A) ) . (DATE ( 1 ) .HEAD (22) ) » (HE02 ( I > .HE  AO ( 30 ) ) . 
*(COMENT( 1) .HFAD(AP) ) 

DATA  FOUVEC/1 . •-•/.SLASH/ 1 » •/•/ 

DATA  IPCO/* T •/.08CD/»0^/.BLANK/^  '/.UBCD/^U'/t 
*LPCO/'l  '/.CSCD/^C^/.SPCO/^S^/.PBCO/^P^/f 
*ABCO/' A ./.TmCD/^T^/.FBCO/^F‘/ 

DIMENSION  INVEC(I3) 

DATA  INVEC/^NCPA'.^FOPM^.  •DATE^.^HEDl  •.  •HE02^.^NHN^.^OPTd. 
••NACR^ . •SONA. . .DATA* . •LINE^ . *CHAN‘ . •♦ENO»/ 

DIMENSION  CAPO(62) .ACAWO(20) 

CHANNEL  C«RD  counter 

ICHNCT  =0  . 


***  SUN  angle  counter  - CONTROL  CARDS 
ISUNCT  = 0 

input  DATA  TAPE  COUNTER 


C 

c«»* 

c 


NUMFIL  = 
NOLir.'E  = 


default  settings 


10 


?0 


DO 

1000 


1020 


22 

1 


1.6 
1.8 
= 60 


TMOPT  = 1 
ISUNT  s 0 
TSnPT  = 0 
ISUNC  = 0 
MACROS  = 1 
TDATTP(l)  = 

IDAIFL(I)  = 

NDPEAT  - A 
DO  10  I = 1.6 
DO  10  J = l.A 
NFPAT(T)  = 4 
FFTVFC(J.I)  = 

CONTINUE 
DO  20  I = 

DO  20  J = 

ISUN( j, I ) 

CONTINUE 
FOPMM  = 1 
PRUNIT  = 30 
PEMINO  PHUNlT 

PFAO(CPOUf T.IOOO) (ACAHD(I) .1  = 1.20) 

FDWMAT (20AA) 

WPITP(PPUNIT.lOnO)  (ACAPDd)  .1  = 1.20) 

PFWiNn  RWUNIT 

RFAP  (RRUrvIT.  lOlOCOOE.CAP'O 
10)0  format ( AA.6« .62A1) 

f DEWINO  RR'J.\TI 

VRITF (PPIU  HT, 1 020) CODE. CAPO 
format (7X«AA.6X.b2Al ) 
rni  r n 
ISTAPT  = 0 

DD  on  I = 1 . 13  , , 

IF  (COnE.E'-'.  I'JVFC  < I ) 1 GO  TOO  00 . 1 SO  . 20  0 . 2S0 . 30  0 . 3^0 . 400  . ASO  . SOO , 
•GS0.600,6'’0. 700)  . I 


SETOOOlO 
SETOOO|0 
SfeTOOOSO 
SET00040 
SETOOOSO 
SET00060 
SET00070 
SET00080 
SETR0090 
SETOOlOO 
SETOOllO 
SET00120 
SET00130 
SFT00140 
SET00150 
SET00160 
SET00170 
SFT00180 
SETC0190 
SET00200 
SET00210 
SET00220 
SET00230 
SFT00240 
SET00250 
SFT00260 
SET00270 
SET002BO 
SFT00290 
SET00300 
SET00310 
SET0032C 
SETC0330 
SET00340 
SET00350 
SET00360 
SET00370 
SET00380 
SET00390 
SFT00400 
5ET00410 
SET00420 
SET00430 
SFT00440 
SfcTOOASC 
SET00460 
SET00470 
SET00480 
SET00490 
SETOOSOO 
SFTOOSIO 
SET00520 
SET00530 
SFT00540 
SET005S0 
SET00560 
SET00570 
SET005R0 
SFT00S90 
SfcT00600 
5ET00610 
5ET00620 
SF.T00630 
SET00640 
SETOObSO 
SEin0660 
SET00b70 
SETOObWO 
snoot  90 
SF  T00700 
StT00710 
SF  T00720 
SF.T00730 
SET00740 
SF.T007SO 
StT00760 
SF  T00770 
SF.T007H0 
SET00790 


^r7 


PILE- 


SET18 


40 

CONTINUP 

SET00800 

WRTTP<oktunT, 1030) CODE* CAPO 

SET00810 

1030 

FOPMATC  INVALID  CAPO  - I6N0PED*/T5. A4t6X,62Al ) 

SET00820 

PO  TO  SO 

SFT00H30 

C 

SET00840 

C*** 

number  of  channels  pep  pass  capo  image 

SET00850 

C 

SET00860 

100 

J * NXTCHP(CARD»C0L) 
IF(J,F0.HL4rR)60  TO  80 

SFT00870 

SET00880 

J = NilMBEfii(CARO«COL*NCMPAS»ISTART) 

SET00890 

RO  TO  SO  , 

SET00900 

c 

StT00910 

(***• 

format  CARO  IMAGE  - OUTPUT  FILE 

SET00920 

c 

SET00930 

ISO 

J a NXTCHR(CARO,COL) 

SET00940 

IFtJ.EO.LBCO)  FOHMM  s 2 

SET00950 

GO  TO  SO  . 

SET00960 

c 

SF.T00970 

c*** 

DATE  CAPO 

SET00980 

c 

SET00990 

?nn 

RE AD (RRUN IT, 1040) DATE 

SETOIOOO 

1040 

format ( 10XtTA4) 

StTOlOlO 

REWIND  RRUNIT 

SET01020 

GO  TO  80 

SFT01030 

c 

SET01040 

c*** 

HEOl  CARO 

SET01050 

c 

SET01060 

?so 

REAO{RRUNIT.1050)HE01 

SET01070 

lOSO 

FORmaT<10X»15A4) 

SET01080 

PEW  I NO  RR'JNIT 

SFT01090 

GO  TO  80 

SETOl 100 

c 

SETOlllO 

c««* 

MED?  CAPO 

SFT01120 

c 

SET0U30 

300 

REAO(RRUnIT.105O)HEO2 

SETOl 140 

PFWINO  RPUNIT 

. SET01150 

GO  TO  80  . 

SETOl 160 

c 

SETOl 170 

c*** 

NLINES  (6)  CARO  FOR  PSEUDO  OPTION 

SETOl ISO 

c 

SETOl 190 

3S0 

J = M)M8FR(CAR0.C0L»ARRAY(l)f ISTART) 

SET01200 

IF(J.GT.6)  J = 6 

SET01210 

no  360  JJ  = 1*J 

5ET01220 

360 

NLTNFS(JJ)  = ARRAY (JJ) 

SET01230 

GO  TO  80  • ■ 

SFT01240 

C 

StT012S0 

c*** 

OPTION  CARO  image 

SET01260 

c 

SET01270 

400 

J = NXTCHR (CAPOtCOL) 

SET01280 

IF(J.EO.CRCn)  IMOPT  = 1 

SET01290 

IFf J.FO.SHCO)  IMOPT  = 2 

SET01300 

IF ( J.FO.PrtCD)  IMOPT  = 3 

SET01310 

IF(J.EO.APCO)  ISOPT  = 1 

SFT01320 

GO  TO  80 

SL  T01330 

c 

SET01340 

c*** 

SPATIAL  OPTION  ...  NUMflER  FIELDS  TO  BE  JOINED  ACROSS 

SET013S0 

c 

SET01360 

4S0 

J = NUM8ER(CARO.COLtNACROS»ISTART) 

SETOl 370 

GO  TO  80 

SET01380 

c 

SF.l  01390 

c*** 

SUN  angle  capo  images 

SET01400 

c 

SET01410 

500 

J = NXTCHR(CAPO«COL) 

SET01420 

TF(J.f'!F.T8Cn)G0  TO  SIO 

SET01430 

TSUMT  = 1 

SET01440 

GO  TO  80 

SKT01450 

510 

ISUNCT  = ISUNCT  ♦ 1 

SI T01460 

COL  = 0 

St  T01470 

ISUNC  = 1 

St  T01480 

J = Ml)MBER(rARr). COL. ARHAY(l). ISTART) 

SET01490 

0 

nn  S?0  JJ  = l.J 

SETOlSnO 

IS'IN(JJ.  ISUNCT)  = ARRAY(JJ) 

St  T01510 

5?0 

CONTINUE 

St  T01520 

GO  TO  80 

St  T01S30 

r 

SETOISaO 

c*** 

OATA  TARE  CARO  images 

St  TOibSO 

c 

St.  TO  1S60 

SSO 

J = NXTChP (CARD, COL) 

Sfc  TOlb  ^0 

if  ( J.FO.lHCnXiO  TO  570 

SETOlbSO 

FILFJ  SETIP 


C 

C**» 

c 


c 

c*** 

c 


c 

c*»* 

c 

555 


C 

c*** 

c 

570 


C 

c**# 

c 


IFfJ.NE.OrtCOJGO  TO  595 
OUTPUT  FILE 

J a FlN0l2(Cft90tC0L»SLASHJ 
IF(J.NF.?»60  TO  595 
J a NXTCH«(CA90,C0L) 

IF(J.E0.FBCn>G0  TO  555 

UNTT  NU*<BE9  OF  OUTPUT  FILE*  THEN  FILE 

J a FIN012(rA'RO*COL»EOUVEC) 

1F(J.NF.?»60  TO  595 
J a NUHRtH(CflHO*COU»OATAPE»ISTART) 

U = FIMD12(CARn*C0L«E0UVEC> 

IF(J.^4F.2)60  TO  595 
ISTAPT  a 0 

J a NUMRER(CARD«C0L.0ATF1L»1START) 

60  TO  flP 

FILE  NUMhEH,  then  unit 

J a F1N012(CARO*COL.EOUVEC) 

IF(J.4vr.2)60  TO  595 
J a N'UMHER<rARn,COL*DATFlLf  ISTART) 

J a FriOl2(CARO»COL.EOUVEC) 

IF(J.NF.2)60  TO  595 
ISTART  a 0 

J a NUM3ER(CARO»COL*OATAPE»ISTART) 

00  TO  AO 

INPUT  FILES 

UU“F1L  a NUMFIL  * I 
IF{NU“FIL.6T.(S)00  TO  590 
J a FIND! 2<CAHO»COLtSLASH) 

TF<J,NF.2)G0  TO  590 

J = NtTCHi^CCARnfCOL) 

•F(J.FO.FPCn)GO  TO  575 

UNIT  NUM5FR  OF  INPUT  FILE*  THEN  FILE  NUMBER 


575 


C 

c*** 

c 

500 

505 

1050 

C 

c*»* 

c 

600 

c- 

c*** 

c 

690 


J a FTND12 
IF  (J.UF.2) 

J = NlJMBPPt 

J a FlNDl? 
TFIJ.rlF.?) 
TSTAHT  a 0 
J a NUHBE9 
GO  TO  An 
J a FTND12 
IF  » J.KF.?) 
J = number 

J a FlNOl? 
TFU.NF.2) 
ISTAFT  a n 

J a number 
GO  TO  AO 

ERRORS 


(CARD*COL*EOUVEC) 

GO  TO  590  ' 

( C ARO * COL. lOATTPINUMFIH .ISTART) 
(CARO. COL. EQUVEC) 

GO  TO  590 

( CARO. COL. IDATFL (NUMF ID . ISTART) 

(CARO. COL. EQUVEC) 

GO  TO  590 

(CAKO.COL. IOaTFL (NUMF id .ISTART) 
(CARO. COL. EQUVEC) 

GO  TO  590 

(CARO.COL. lOATTP (NUMF ID .ISTART) 


NtiMFTL  = NUMFIL  - 1 
WRTTF(PRTUNT.1060) 

FORMAT (•  ERROR  ON  ABOVE  INPUT  CONTROL  CARD*) 
GO  TO  AO 

LINES  IN  PSFUDO  OPTION 

NOI.INF  a NIJMHER(CAR0. COL. LINES. NOLINE) 

GO  TO  AO 

CHANNELS  CARD 

ICHNCT  a ICi^NCT  ♦ 1 
TE(ICHNrT.GT.6)G0  TO  AO 
J a number (CARO.COL. array ( 1 )» ISTART ) 
IF(J.GT.3n)J  a 30 
00  660  JJ  a 1 . J 
FETVEC(JJ.lCHtJCT)  a ARRAY(JJ) 


SET01590 


SET01670 
SET016B0 
SET01690 
5ETOI760 
^ET0I710 
SET01720 
SET0I730 
SE  01740 
SE( 01750 
Sf  T01760 
Sf.T01770 
S£T01780 
SET01790 
5ET01800 
SET01810 
3ET01820 


|FTO 

SETO 


830 

840 


5ET01850 
5ET01860 
5ET01870 
SET01880 
SET01890 
SET01900 
SET01910 
SET01920 
SE701930 
SET01940 
■3ETOI95O 
>ET01960 
SET01970 
V.ET01980 
5ET01990 
'.ET02000 
SET 020 10 
5ET02020 
5ETOP030 
SET02040 
GET  02050 
sr;T020b0 
SET02070 
SET020AO 
SET02090 
SET02100 
SET02110 
SET02120 
SET02130 
SFT02140 
SET02150 
SET02160 
SET02170 
SET02180 
SET02190 
SET02200 
SET02210 
5ET02220 
SET02230 
SET0224U 
SET02250 
SET02260 
SET02270 
SET022A0 
5ET02290 
SET02300 
SET02310 
SET02320 
SET02330 
Sf T02340 
SLT02350 
SET02360 
5ET02370 


0<JO  t-'UO  UUU  OOO  OOO 


FRF*  SET18 


6f>0  CONTTNUF 

lyFFATdCHNCT)  » J 
60  TO  ftO 


IF(IM0PT.EQ.2)LIH1T  = NUMFR 
no  ?10  J « ItLlMIT 
ARRAY(?)  * 0 

JJ  =_LAREA0(ARRAY(1UARRAY(3)  »FLD1NF  ( 1 1 J)  t ARRAY (2) ) 
xJSAVE  ® 0 

TF(JJ.NE.1»G0  TO  750 
710  CONTINUE 

JJ  s LAREA0(ARRAYm*ARRAY(3)fARRAY(4)*ARRAY(2)> 

IF(JJ.NE.O)00  TO  750 
GO  TO  770 

•••  error  in  field  CAROS 
7<;n  wRTTF(PRTUnT,  1070)  JSAVE 

1070  FOPMAT(»  ERROR  IN  FIELD*. 110.*  OR  SEND  CARD  MISSING*) 

CALL  CMERR 

***  PROCESS  INFORMATION  . 

770  CONTINUE 

IFdCHNCT.EO.NUMFIDGO  TO  775 
WRTTE(PkTUNT,1080) icmnct.numfil 

10«0  format (*  NUMBER  OF  CHANNEL  CARDS*. 15.*  DOES  NOT  MATCH  NUMBER  OF 
**PATA  FILES'. 15) 

TCHNCT  = NUMFIL 

775  IFdSL'NC.EJ.l.AND.lSUNCT.NE.NUMFIDGO  TO  780 
GO  TO  7PG 

7«0  wPTTF (PRTUNT. 1 090) ISUNCT. NUMFIL 
lOQO  FORMAT (•  NUMBER  OF  SUN  ANGLE  CARDS*. 15.*  DOES  NOT  MATCH  NUMBER*. 
♦•OF  OATA  files*, 15) 

ISUNCT  = NUMFIL 
7B5  IFdMOPT.EQ.DGO  TO  795 


CHECK  NO.  channels  EQUAL 


SPATIAL  OR  PSEUDO  OPTION 


NOFEAT  = nFFATO) 

TF  (NUMFIL. EO. 1 ) GO  TO  795 
00  790  J s 2, NUMFIL 
IF(MFFAT  ( J)  .EN.imFFAK  1 ) >60  TO  790 
WPTTF (PPTUNT.llOO) J.NFEAT (J) .NFEAT(l) 
lino  F0RMAT(»  number  of  features  of*. is.*  FILE*.I5. 

**  TS  NOT  EJUAL  TO  FIRST*. 15) 

NFFaT(J)  = NFEAT(l) 

700  roNTTrsiiiF 
do  TO  B06 

**♦  FEATURES  IN  CHANNEL  MERGE 

795  TOIIM  = 0 

DO  BOO  I = 1, NUMFIL 
inUM  = IDUM  ♦ NFEAT(I) 

«no  conttnuf 

IF(IDUM.LF.TO)GO  to  P05 

wPTTF(PWTUNT,n05)  (NFFAT(I)  ,I  = 1, NUMFIL)- 
1105  format («  FEATURES  ADD  UP  TO  A NUMBER  GREATER  THAN  30*. 615, 
*•  FX!TT^'G•) 

CALL  CMFRH 
30G  nofeat  = IDUM 

•♦*  SET  NOS  AMP  and  noline 


(InOPT.NE.?)  NACROS  * 1 
= n 

J = 1. NACROS 

= (FI niNF (5.J)  - FLDINF(4,J) )/FL0INF(6,J) 
= NOSAMP  ♦ NSS(J) 


T06  TF  (InOPT.NE.?)  NAC 

NOSAMP  = n 
no  BIO  J = 1. NACROS 
N5S(J)  = (FI niNF (5.J)  - 
NOSAMP  r NOSAMP  ♦ NSS(J 
BIO  CONTTNUF 

NOOWN  = NUMFIL  / NACROS 
IF(I"OPT.NE.?)NliUwN  = I 
NOLINF  = n 
TCT  = 0 

NnnwNi  = n0Orn*nac.hos 


SFT023B0 
SET 02390 
SET02400 
SET0?410 
SET02420 
SET02430 
SET02440 
SET02450 
SET02460 
SET02470 
SET02480 
SET02490 
SET02500 
SET02510 
SET02520 
SET02530 
SET02540 
SET02550 
SET02560 
SET02570 
SFT025B0 
SET02590 
SET0P600 
SFT02610 
SET02620 
SET02630 
SET02640 
SET02650 
SET02660 
*,SET02670 
SET02680 
SET02690 
SET02700 
SET02710 
SET02720 
SET02730 
SET02740 
SET02750 
SET02760 
SET02770 
SET027B0 
SET02790 
SET02B00 
SET02810 
SET02BP0 
SET02B30 
SET02840 
SET02850 
SET02860 
SET02870 
SET02880 
SET02890 
SET02900 
SFT02910 
SET02920 
SET02930 
SET029A0 
SFT029S0 
SFT02960 
SF.T02970 
SfcT029«0 
SET02990 
SET03000 
SETOSOlO 
5ET03020 
SFT03030 
SF  T0304O 
Sf T03050 
SF  T03060 
SLT03070 
SET030PO 
SF.T03090 
SET03100 
5F  T031 10 
SET  03 120 
SET031 30 
SET03140 
SET  03 ISO 
SET03160 


nnn  nnn 


no  nis  J B ItNDOWNltNACROS 
TCT  • ICT  ♦ I 

inUM  a (FLDINFJZ.J)  - FLOINF ( 1 ♦ J» ) /FLDINF (3. J) 
NOLINE  a NOLINE  ♦ IDUM 
IF  (IHOPT.EO.?)  NLINES(ICT)  a lOUM 


..  . rONTINUE 

IF<Nn0WN,E0.1 )60  TO  830 

NOOWNI  a NDOii^N  - I 
no  820  J a l,NOO»<Nl 
no  820  JJ  a i,NACt»0S 

iTFMP  a JJ  ♦ J * Macros 

NSSUTFMP)  S'  NSS(JJ) 

820  CONTINUE 

set  linptr 

830  LINPTR(l)  a I 

►**  STORE  FLDINF 

IF(lN'nPT.E0.2)GO  TO  833 
no  832  vJ  a 2,6 
no  B3?  JJ  a 1*6 
FLniNF(JJ,J>  a FLOINF(JJfl> 

83?  CONTINUE 

833  IFn80PT.NE.3)00  TO  840 
00  835  J a l.NUMFIL 

LINPTMU  ♦ 1)  a lINPTR(J)  ♦ NLINESIJ) 
835  CONTINUE 
840  RETURN 
END 


03|30 
-9 11*0 
03250 
IET03260 
SET03270 
SET03280 
SET03290 
SET03300 


i 


1 

21.  GTDDM  PROCESSOR 

1 

PlLPt 

fiTnOM 

C 

WRITTEN  BY  C J AHLERS 

GTDOOOlO 

GTOOOOZO 

r 

6P0UN0  TRUTH  TARE  OUMP  ROUTINE 

GTO00030 

UTOOOOAO 

SURWnUTlNE  fiTnOH( ARRAYtTOP) 

fiTOOOOSO 

\MPI.iriT  INTFPER  (A-Z) 

GT000060 

ni*^ENS10N  ARMAY(l) 

6T000070 

CALL  ^ETIR 

GTOOOORO 

CALL  nDP(AWRAY,TOP> 

GTD00090 

RETURN 

GTOOOlOO 

end 

GTOOOllO 

ALPHA 


)0 

2ft 


FUNCTION 


ALPHAIS) 
iNTFfiEH  (A- 
«(?A) 


Z) 


nAtA~A/<A'««H*«iC*t'0*«'E*t«F't'6'*'H*«*P«'Jt«'K«*'L'«*M'« 

»2ft 


no^lft  i«i, 

aloha»i 

TFfS.PO.AI 


continue 

wPITP (6»20) 
format (IM  , 


Am)  HtTURN 


format ( 1M 
RETURN 
FNO 


, S 
t‘'*»  'THE 


SYMdOL  'tAlt*  CAN  NOT  PE  USED,') 


ALPOOOlO 
ALP00020 
ALP0OU3O 
ALMOOOaO 
ALPOOORO 
ALPUOOAO 
ALPC 


ALPOOOHO 
RO 
0 
0 

- --,20 

ALP00I30 


fLPO- 
ALPOO. 
ALPOOii 
ALPooi; 


ORIGINAL  Pfi 

^ POOR  Qj 


Ge  r 
‘^LITY 


ntFt  nOM 


WPITTFlv  H 
lPnUT|MF 


S»IB 
*»PLin 
NSfON 


n 

n 

n.  _ 

PAT4 


HY  c W AMLCHS 
H4Y,T 


..  nD**(«RHAY*TOP) 
INTEfiCH  (A-Z) 
4‘»P4Y(1) 


NSTAN  r»'4TX(ll«l9) 
AiSTON  FFTVgCOO) 


iSl. 

FfTVFC/30»0/ 
ftIMENSlON  I6aTA0060) 
niMENStON  «1.0CK(6> 

COMMON  /TAMEMO/  IUNIT,IFPST»FSCAN,SAM|NO«S4MlNC.REAOYtNSC*N 
Ll'‘CjIO<;;''0>  .OH«LHUF(3f»)  ,JRECOO)  .IBYTEOO)  .NBUFS.FlLENO 
• .L1NInC»N«;AMP,N0CM4N»  IFQRMT 

/RT*’i'/NR0WtNM«T.PRTKEY»VLBC6)  »0TPUU«6TR0F« 

. CTucir  .ATurtr 


COMMON  , 

• GTwRUtGTwRF.GTNOF 


r. 

c 


OUIVALEUCF 

'^uIvalence 

UNIT*:GTr.iyU 

TUMJTsGTRDU 

FORMTsIFORMT 

NFOFsO 

FTLFaO 

NOFFATsNOCHAN 
FFTVFCm*! 
DAYaP 
mON*0 


(IOATA(l)«ARRAY(n) 
(fOATAl  (1)  •ARRAYOObl)  ) 


YEAMaO 

9lTFaO 


10 


10 


(SOI 


3(16 

I 

3*S6 

« 

366 

« 

.376 


P*xl<J6 
BLOCK (l)al 
BL0CK(?)aU7 
BLf'rK(?)sl 
BL0CK<4)=1 
BLOCt<(^)  = 196 
BLOCK (61 *1 
CONTINUE 
PFWINO  fiTBOU 
BFkTf.n  (iTulWU 
Bnr  = GTPi)F-l 
W»FaGT>PF-l 

continue 

NPPo<;  = i 
M&XBFr  = 3tl60 
icnuNTso 
NOFCsO 
FTLF=FILF«1 
I INFsA 

WRITF  (^'PBT^<)bl ) 
format ( 1^1 ) 

CALL  TAf'HUW  (GTROU.POF) 

CAIL  FSFMTL((STwRU.wRF,ISTATm) 
iiPITc  (*.p,/T.601>  (-TRDF.GTkRF 

FORMAT!  //,t  tape  file  'flA.SXt'BEING  DUMPED  TO  DOT  FILE  '.lA) 
PAValOf,?*^) 

M0N=10(?6) 

VFARsini?  n 
SITFal0(?«) 

WDITF  (“PwT.  3n(-)SITF.OATiMONtYFA» 

IF  (RATIFY, ‘•0.  1 ) .RTTF  (GT»RU«  366 ) S I 7E  «0  AY  t Mr>N  t YE  AR 
IF (PWTr Fr ,F0.?)  WRITE lGTwRU.366)SITF,nAY.M0NtYFAfl 
IF (PRT-E  r .FO. 1)  .Ri TF (GTWRU.  376) SIT^ .0AY,MON,YFAW 
FORMAT!*  STTf;  s t.I6tbY,*0AY=**lS.5Xt*M.0NT(-a*,I5,5X» 

► I Yl-  A-s  • t IS) 

F0CMAT!*61TF  s • . is,  1 X.  iriAYa*  . 15. 1 X . »MONT(<s*  * if,  IX* 


IS. 


MflbK  S Ty  *.*  TYPE  5 C.T») 


• YF  AR=  • 

FORM'.T  ( *S  I rt  S • . IS,  ) X . *riAY=  • . 15.  1 X,  *MONTH=*  . IS,  1X» 

• \ AR=  t , is,  • MASK  * Phase  3 *.*  T'Pf  s gt*) 

format  !••-, I (E  = * . 1 5,  1 X,  *nAY=  • . IS,  1 X,  *MOM  fH=»  , is,  IX, 
* •YEiwxt.ls,'  mask  » INRUT  TYPE  * GT»» 

WRITF !\PMT,sdO) 

Oil  L FLriiiMRLOCK.FETYFC,(JOFEAT» 
f,nn  foomat!///.*  thl  ?()R  Out  LAHELS*) 

?n  roMTir-UE 

IF(EJFEr.r-f  , mloCK  (?)  ) r,u  TO  SO 
CALL  t If  F',n(  U'aTA.FnDI  AR) 

IF  !ff;ni  1R.FU.-1  ) GO  TO  5S 

NFOFsn 

NPF  rsN  <f  r;.  1 

TF!NRFC.Lr  .P)  mH  I TE  ! f^PR  T , «S  0 ) ( 1 0 AT  A ( K ) , K=  1 ,63) 


DDMOO 
DDMOO 
nOMOO. 
ggMOOj 


DDMOOOIO 
DDM00020 
ODM00030 
DDMOOOAO 
QDM00050 
DDMOOOAO 
DDM00070 
ODM0006P 
DOM00090 
Op(AOOlOO 
LlNEKODOHOOilO 
pDMOpllO 
DDMOO 130 
ODMOOUO 
DDM00150 
OnMOOlAO 
170 

Uo 

190 

200 

-JMOOllO 
DOM0022O 
0OH00|30 
DDM002AO 

oomooHo 

0OM00260 
ODM00270 
DDH00|8U 
ODM00290 
DOM00300 
DOmOOSIO 
ODM00320 
ODM00330 
DOM003AO 
OOM00350 
nOM00360 
0UH00370 
DOM003flO 
00''(00390 
DOMOOAOO 
OOM00410 
ODMOosao 
ODK00430 
ODMOOASO 
DD(^004S0 
ODM00460 
DOM00470 
ODM00480 
OI)A*00490 
POM00500 
0[>(-!00510 
OUM00520 
OOM00S30 
Of)MOOS40 
OUM00550 
OOMOOSGO 
00*^00570 
OOM00580 
OOMOOSRO 
DOM100600 
I)OM00610 
nOM.00620 
nriM00630 
nDRAosso 
imMCOftSo 
(in'f  0066U 
DLiMn0670 
iifiMonsHO 
!U'MO06P0 

oom  nu  7 00 
on*'oo7io 
ni(-"no7?o 
l)[if-00730 
f'C.MOOTsO 
!!(;!-n07S0 
Ol'MOOThO 
[)|;m007  70 
(i|!R007rtO 
DU*''  007R0 


riLfi  ooM 


ssn 

c 

• 39 

•0 

7fl/l 

7S9 

55 

298 


if 


II 


iTECNP«T;H50) 
If  INPRT*<i36) 


.Of  wBI 


(lOATA(K) «K>].6TWCC) 


^ 

dTOOTS 

t inATA»PMTf iLINf  I 
fOffMATClH  «5X,19i5) 

00  IP  ‘ 

coN^y 


Tyis^« 

CALL 


Ifiuf 

ftTDTL I 


_«n«T»fNSYM) 

POTR^Y 

STD*^**  iDMTx  .Type  .NSYMI 


WPTTf  (NPHT.7001  K'PE 
fnP*? AT  (///,»  NUPPE 


- Of  SCXN  LINES  REAOa'.lSI 

WOITEIfJPkT.TJO)  totPOf.toTwRF 
fOPMATI*  FlLf  <.I5.SX««MAS  DUMPED  TO  FILE 


fiTPOF«RTPQF*l 
6YwpF»GT.*RF*I 
ROF«Phf *1 


IS) 


VRfcwpF*; 


»Ti-9U 


FNOFTLE  

JF(f ILP.LT.6TN0F)  GO  TO  10 


CONTI NU 

PF><tNn 

PFwlNn 


.TPOU 

GTrOU 


kPITF (NPRT.PSO) 
FnPMAT<*  program 
return 

END 


gtodm  run  completed*) 


ouhoopoo 

UUMpOAjp 

OOM008Z0 

0{)M0083‘ 

ODMOOMA 

ooMooes 

ni)M00G6Q 

DOMOO07O 

ooMooeeo 

UDH00F9Q 
OpMOOOOO 
noMooolo 
nOM00920 
DOH00930 
ODMOORAp 
OPMOC9SO 
OOM009N0 
OOM00970 
00*100980 
nfiM00990 
nD*'ojoo') 
nOMoioio 
noMOioSo 
no«o  10-10 

DOM01040 
nO“Oioso 
oot^oiofto 
piiMoioro 
ODMOfOflO 
HOMO  1090 
OUMOllCO 


riLfJ  OTOOTS 


SU«B0UT]nC  r.TnoTS</lD*T*/«OMT<»UNE) 
IMt»LlClf  iNTeGtPf  <*-?) 

COHMON  ✓C-i-"</nS0W,NPHTiVWTkCV»VL8<6>  »6TB0U» 
1 oTrfOF.GTwHU.GtWPF.GTNOf 

OTMCNSION  OMTX«11.19) *10AT*(1) 

: wSttf  (X).«»on 

9fti  rnoMftTdH  .iox»*GTnoTS*» 

LlNr«LlNE*l 

no  10  i>loti90*io 

K»T/10 

nMtX(LTNE.K>«inXt<((n 
10  roNTiNue 
i»rTuHN 
END 


GTOOOOlO 

gtdoooIq 

GTDOOP30 

GTU0004Q 

&T&00050 

GTQOOOAO 

GT000070 

GTOQOpHO 

GTOOOOVO 

GTOOOIOO 

GTQOOUO 

GTOOOIOO 

07000130 

GTROOUO 


FILF 


GTOTL 


C 


5 


10 

C 

60 


100 

no 

?o 


40 

30 


WRfTTFN  C W AHLEMS 
5UHP0UTINE  6TnTL(0MTX»NSYM) 

IMPl  iriT  INUGEH  (A-7>* 

fOMHON  /TR/TPNSl (?56) fT9NS2(26) #TRNS3(26) .TV(ll.l9> 
OATA  B/»  •/ 

DIMENSION  DMTX(lltl9) 

DO  5 1=1.26 

T9NS?m»B 

TRNS3(n=8  . . 

CONTINUE 


R8  IS  5;i:}4 

' (i. 


<;d=Omt*  (I .J» 

SYMsTRNSl (GD) 

NUMsALFHA (SYM) 

TRNS? (NUM) =SYM 
DMTX ( I . J) =SYM 
CONTINUE 

WRITF(6.60)  (T«NS2(I) »I=l»26) 
FOftM»T(lH  .5X.26A1) 

NSYMrO 


00  100  1=1.26 

lF<TRNC?(i) ,NE.B)  NSYM*N5YH.1 

TPrTBNSPd)  .NF.H)  TRNS3(NSYMl=TRNS2(n 

CONTINIIC 

wpTTf (^.110)  (TPNS3(1) .1=1.26) 

F0R».-ftT(///,5X. 'CATEGORIES  FOUND:  '.geAD 
WRTTP(6.?0) 

format UHl .//.5X. 'THE  209  DOTS  TRANSFORMED') 
no  40  1=1.11 

WOITF(ft,30)  (OMTX (I.J) .J=1.19) 

CONTINUE 

FOPMATdH  .5X,19(AX.A1)) 

return 

END 


&TD00010 

GTD00020 

6TD00030 

GTDD0D40 

GTDOQOSO 

GT000060 

GT000070 

GTDOOOAO 

GTD00090 

GTDOOlOO 

GTOOOllO 

GT000120 

GT000130 

GTUOOUO 

GT000150 

GT000160 

6TD00170 

GTDOOlAO 

GT000190 

GTD00200 

GT000210 

6T000220 

6TD00230 

GT000240 

GT000250 

GT000260 

GTD00270 

6T000280 

GT000290 

GTOOOiOO 

6T000310 

GTD00320 

6TD00330 

GT000340 

GT0003S0 


nnn 


FILE  6T0WR 


U 

111 


12 

13 

14 


2S 


33 

43 

30 

53 


WHITTEN  BY  C W AHLFRS 

THIS  PH05HAM  W->ITE5  I.ACIE  FORMAT  DOT  FILES 
RIVEN  A '1ATHIX  OF  OOT  LABELS  L A TYPE  MASK  MATRIX 
SUHROUTINE  6TI)WH(0MTX,TYPE»NSYM) 

IMPLICIT  INTEGER  (A-2) 

DIMENSION  0MTX(U.19) 

DIMENSION  OwRIlS) 

common  /TR/TRNSl (256) .TPNS2I26) »TRNS3(26> ♦TY(ll»l9) 
common  /6TMK/NR0h.MPHT.PHTKEY»VLB(6» iGTRDUfGTROF* 

* GTwHU«GTWHFf6TN0F 
WHITE(NPHT.ll) 

FORMAT(1H1,//,10X,iLACIE  format  OOT  LABELS*) 

WRITE  (MPHTtlin  UTWRU 
FORMATdH  . lOXf ‘WRITTEN  TO  UNIT  *,I5) 

IF(TYPt.EO.l)  WRlTFtNPRT,12) 

IF(TYPF.,E0.2)  WWITF(NPHT»13) 

IF(TYPE.E0.3)  WRITF(NPRT,i4) 

FORMAT(//»10Xt 'TYPES  BASED  ON 
■ “ ' BASED 
BASED 


ON 

ON 


A 

A 

AN 


TRANSITION  YEAR  MASK') 
phase  THREE  MASK*) 
INPUT  MASK*) 


FORMAT (//.lOX, ‘TYPES 
format (//»lOXt ‘TYPES 
NTYPES=2 

DO  30  TT=1,NTYPES 
no  30  SS=l,NSYM 
COUNT  = 0 
DO  25  1=1,11 
DO  25  J=I»19 
U=J*19*(I-1) 

IF(TY(I,J) .FQ.TT.AND.DmTX(I,J) ,F0.TRNS3(SS) ) 

IF  (TY  { I , J)  .EO.TT.  ANO.OHTXd  » J)  ,EN.  TRNS3  (55)  ) 

iFirOUfiT.EO.lS)  WRITE  (NPRT, 33)  TT.TRNS 

IF (COUNT. EO. IS)  WRITE (GTWRU, 43)  TT,TRN 
IF (COUNT. EQ. 15)  COUNTsO 
CONTINUE  _ . 

IF (COUNT. 6T.0)  WRITE (NPRT.33)  TT,TRNS3(SS) , (OWR(K) ,K=1, COUNT) 
IF(COUNT.GT.O)  WkITE(GTWHU,43)  TT»TRNS3(SS) , (OWR(K) ,K=1, COUNT) 
FORMftTdH  ,5X,*nOT  *»I1,2X,A1,3X»15I4) 

FORUATCOOr  *,11,2X,A1»3X,15I4) 

continue 

WRITF(GTwHU,53) 
format ( 'SEND* ) 

RETURN 

END 


C0UNT*C0UNT»1 
0WR(C0UNT)sIJ 
(5S) , (OWR(K) ,K=l,COUNT) 
3(5S) « (nwR(K) ,K=1. COUNT) 


GTDOOOlO 

6TD00020 

GTD00030 

GTDOOOAO 

GT000050 

GTD00060 

GTD00070 

GT000080 

6TD00090 

GTonOlOO 

GTOOOllO 

6T000120 

GT000130 

GT000140 

GT000150 

GT000160 

6T000170 

GT000180 

GT000190 

GT000200 

6TD00210 

67000220 

GTD00230 

6T000240 

GT000250 

GT000260 

6T000270 

GTD00280 

GTD00290 

6T000300 

GT000310 

GT000320 

GT000330 

GTD00340 

GT000350 

GT000360 

GT000370 

GTD00360 

GT000390 

GTD00400 

GT000410 

GT000420 


riLFt  6TTRNS 


SUBROUTINE  OTTHNS" 
implicit  INTEREP  <A-a> 

OAT»  W»S«H. tO. N/ »W 'O'.  *N*/ 
COMMON  /TR/TWN51 (256) *TRNS2 (256) ♦TPNS3(256) 

00  10  1*1.256 
THNS1 (1)*N 
10  CONTINUE 
TBNSl (99) aW 
TPNSl ( 124)*W 
TONSi(i00)*S 
TBNSl  1 125). *S 
TBNSl (lOl)aB 
TBNSl (126)*B 
TBNSl (102)*R 
TBNSl (127)=B 
TPUSl tl03)*F 
TBNSl (12S)aF 
TBNSl (104)*0 
TBNSl (129) *0 
00  20  1=1.15 
II*I*15 
TK'NSl  (!)aW 
TRN51  (ID  *S 

20  continue 

RETURN 

ENO 


GTTOOOlO 

GTT00020 

GTT00030 

GTT00040 

OTT00050 

GTT00060 

GTT00070 

GTVOQOrtO 

GTT00090 

GTTOOlOO 

GTTOOllO 

6TT00120 

GTT00130 

GTT00140 

GTT00150 

GTT00160 

GTT00170 

GTTOOlOO 

GTT00190 

GTT00200 

GTT00210 

GTT00220 

GTT00230 

6TT00240 

GTT00250 

6TT00260 


oor>  ^ nnnn 


FlLFt  «;ET19 


01 


'Pii  QUALrry 


fFt<n 


U«TTTEN  by  c w ahlers 

«;uaR0UTl^E  StTia 
IMPLICIT  INTFRFk  IA-Z) 

DIMCNciTON  CnoE(in)  ,CAB0(6?)  tEQUCOMO)  *ACARO(20) 

niwFNSION  SLaSH(2) 

DATA  SLASH  /!,•/•/ 

DATA  COnE/»TBANt,iHeAn*»'WRlT»f 

* , lOATF*. ‘COHMi , •HEOl • , tME02»* •♦END'* 'DUMP*/ 

DATA  FiJUCOM/?,  « = • , I , 1/ 

BATA  V/*V»/.PLNK/«  •/.U/'U‘/fFF/»F*/t00/»0*/tP/*P*/ 

DATA  T/»T'/ 

nATA  {)0/'?«A,II/»I*/ 

T^'CLl)OF  C<YM0<],LIST 
TNCU'OE  COMPKa.  list 
INCLUDE  CO«t»KE,LIST 
INCLUnP  C»^fi»^14.LIST 

COMMON/ !NF0OM/NOCLS?.N0SUH2«N0FeT2tVARSZ2»T0TVT2*N0FL02» 

* AVAW2.COVA«2.CLSI02.SUHN0?tSUP0S2.FL0SV2.VEBTX? 

* FFTVCZOO)  »SUBVC2(75)  .SU*IPTR(75)  .CLSVC2(60)  * 

* <FMPTS(60)  .NO(jRP»6HPNAM(60)  *GRP0EX(6l)  ♦ 

* GRt-CHK  (61  ) »GR0UPS(124) 

DIMENSION  HEDl  (IS)  »HED2(1S)  tOATEO)  »C0MF.NT(15) 

FOttl valence  (HFOl  (1)  tHEAO(A)  ) . (DATE  (1 ) .HEAD (22) ) , 

? (MEO?(  1 ) .HEAOOO)  ) . (COMENT(l)  ,HFA0(49) ) 

COMMON/(5LOBAL/HFAD(63) .maptap*datapf»savtap»bmfilf*bmkey* 

* HlSFIL.HlSALY.TRFORMtERIPTP.ERPKEY.MAPUNTfrVOFlLF 

* nPUMA0,0RKvDS.PA6SI2,DATFlLf STAFlLt ASAV»ASAVFL 

* .NHSTIIN.NnsTFI  ,SCTNU(').MAPFIL 

* ,OOTU!MT,DOTFIU.NCMPAS.TRNSFLtPMTRFLtHlSTFL»PCHUNT* 

* rP[HI'''T.PPTUN7  .PANOIO 

COMMON  /(iTaK/NR0P.NPPT«MSKKEY»yL8(6) tOTRDU.GTRDFt 

* GTx)Mij.fiTwRF,r,TNOF 

COMMON  /T APPRO/ iunit»ifmst.fscan,sameno.saminc.peaoy.nscan, 

* LlKC.IO (210) .OaL.LHUF (30) , JREC (30) » IPYTE (30 ) tNBUFS.F ILENOtL 

* .LININC  *NSAMR,NOChAN. IFORmT 

COMMON  /TR/TPtMSl  (256)  t TRN52  ( 26)  ♦ TRNS3  (26)  tTYdltlR) 

OIMFNSTHN  PR31  ()<})  ,Ph32(16)  ♦PH33(19)  tPM34(19)  »PH35(19) 
dimension  P-<3N(  19)  .PH37  ( 10)  ,PH38  (19)  »PH39(  19)  *PH310  (19) 
DIMENSION  R-‘3]  1 (10) 

data  pri1/9»i ,2,2* It lt2*2»n*l/ 

PH32/lt2tlt2«lt2t2tlt2t2»lt2fl«lt2»ltlt2»l/ 

PM33/ ).?,?, 3* 1, 2, 1,2,3*! ,3*2, It 2tl t 2/ 

RH34/2,?,! ,1 ,2, 1,2, 2, 3*1, 2, 1,2,2, 1,2,2, 2/ 

PH3S/ 1,2.2, 3* 1,3*2, 1,1, 2,1, 1,2, 2, 3*1/ 

PW36/ 1.2. 2,1 .4*2.1 .1,4*2, 1,2, 1,2,1/ 

PM37/ 1.2, 2, 1,2, 3* 1,2. 2.1, 2, 1,3*2, 1,1, 2/ 

Pm  3*/ 3* 1,10*2, 1,4*2,]/ 

RM39/ 1.2. 1.2,1 .1,2, 2. 1,1, 2, 1,2,1, 4*2,1/ 

09310/4*1.4*2,1,1 ,2, 3* 1,2, 1,1, 2, 2/ 

P931 1/1 .2, 1 ,1,2, 5* 1,2, 1, 1,2, 2, 3*1 ,2/ 


data 
data 
data 
data 
data 
data 

r>ATA 
DATA 

data 
data 

dimension  MVECOO) 


50 


5S 


7FP0  = () 

G0DF=n 
OTOOUsl? 
r,7WRU  = ?3 
GTROFsI 
GTWPF=1 
GTN0P=1 
L1NF=0 
NPRT=.RRTUMT 
NPOR=rPDUNT 
NOl AP  = 0 
mokkEY  = i 
NPUT=1 A 
GTNOPsl 

NOCHAMr 1 
TFORMTr] 
nn  SA  1=1,256 
TPNSl (I)=00 

OD  5S  1=1.11 
no  5S  J=1 , 19 
TY ( 1 . J) =-10A 

roNT  piHP 

WRITE (NoRT.lOO) 


SETOOOlO 

SET00020 

SET00030 

SET00040 

StTOOOSO 

SET00060 

SET00070 

5ET00080 

SET00090 

SETOOinO 

SFT00130 
SET00140 
SET00150 
5FT0016C 
SETOOlTO 
, SFT00180 

SET00190 
SET00200 
SET00210 
SET00220 
SET00230 
SET00240 
SET00250 
, SET00260 

SFT00270 
SET002fi0 
SET00290 
SET00300 
SF.T00310 
SFT00320 
5F.T00330 
INENOSf.T  00340 
SET 00350 
SET00360 
SET00370 
3ET00380 
SET003O0 
SET00400 
SET00410 
SET00420 
SET00430 
SET00440 
SET00450 
SET0C460 
SF-TO0470 
SET004HC 
SF.T00400 
5ET00500 
SET00510 
SET00520 
SET00530 
SET00540 
SET00550 
SET00560 
SET00570 
SFT00580 
SET00590 
Sf  T00600 
SET00610 
SFT00620 
SET00630 
SET00640 
SFT00650 
5ETA0660 
SET00670 
SFT('06S0 
SET006QO 
SET00700 
SI T0071 n 
St  Y0OT2O 
Sf  TOO  13(1 
SF  T00740 
5tTO07S0 
Sf  T00760 
St  T00770 
Sf  T('.f)700 
SET00790 


00-7  onr»  r»no  r>  or»n  r>nr» 


mf  t «;eTio 


100 


lOS 

103 


1?0 

no 


I 30 
1->S 
140 


1‘iO 

I'i? 

1^3 


ISA 


F0BWAT(/11X»« INPUT  SUMMAHYt//) 

SET  UP  REREAD  PUFFER 
BRIINTT  a 30 

CALL  R£REA0(RRUNIT*80) 

PUT  CARD  IN  PUFFER 

PE4O(mR0R.103) (ACARO(I) f Ial*20) 
format  (?0A4). 

WPITF  (Rt>U(vlT.103)  (ACARD<  n •I«l»20» 

REMIND  RRUNIT 

RE AO ( RRUN I T . 1 1 0 ) CODE  I ♦ C ARO 
RE w I NO  RRUN IT 
COL=  0 

wRTTF(NPRT. 120) CODElt CARO 
format  (n»A4»ft>t«62Al) 
format(A4»ax.a?ai) 

00  no  Isl.NRlJT 

IF  (COnEl.CO.COOE(I))  60  TO  ( ISOt 1 60* 21 0 t 330 t 370« 

• 390*400*410*420*500) »I 

CONTINUE 
WRTTf (MPRT.140) 

FORMAT ( • iNVALin  CONTROL  CARO  - IGNORED  •) 

60  TO  105 

transformation 

M s N*TCHR(CA«OtCOL> 

TF  (M.FO.SUNK)  60  TO  105 
00  TO  155 
•vRTTF  (NRRT.153) 

format (I  ERROR  ON  T( 'ANSFOPMaT ION  CAROS*) 

00  T'l  105 

U = F TNonirARfl.COL.EQUCOM) 

IF  (J  .NE.  ?)  GO  TO  1S2 
NOI  AHsfl 

NOLAQ  = NUMPEH(CaRD*C0L*VLP*N0LA8) 
rw  sfOL  -1 

1F(NO(.'»O.GT.?)  go  TO  152 
IFCVl.on  ) .GT.VLS(2n  60  TO  152 
IF'VL«T2) .GT,2^6)  go  to  152 
WR=VL« ( 1 ) 

NEcVl.R  (?) 
no  ISO  I=NP.NE 
TRNSl (I) =M 

continue 

60  TO  105 


RFAO  Tape 

IPO  M a NXTCmHCCARO.COL) 

TF  (N  .Fu.  ->LN<  ) GO  TO  105 
IF  (M.FU.U)  GO  TO  IRO 
IF  (n.F<-..ff)  go  to  200 
IPS  WRTTP  (•‘t'RT.  167) 

)o7  FOONAK*  ERROR  ON  READ  TAPE  CARD') 
00  TO  ins 


no 

J = 

FI 

NDIPICARD. 

COL 

*EOUCOf 

t 

IF 

( J 

.Nt.  ?)  60 

TO 

1R5 

M = 

N'U 

M3ER(CA«D* 

COL 

*GTHOUi 

i7E*^0) 

roL 

COL  - 1 

60 

TO 

no 

200 

J = 

FI 

F0i2(CAPn. 

COL 

.EOUCOM) 

TF 

( vl 

.nf.  2 ) 

60 

TO  185 

M = 

MJ 

“REP (CARO* 

cni 

*GTRDFi 

.ZERO) 

COL 

= 

COL  - 1 

60 

TO 

no 

WR 

ITF 

FILE 

1 0 

CONTTN 

'JF 

214 

M s 

NX 

TCHRICARn, 

COL 

) 

IF 

(M 

.F').  f-LNk 

) 

GO  TO  ICS 

IF 

( V 

.ho.ij)  on 

TO 

230 

IF 

(N, 

F J , 1 F ) on 

TO 

240 

215 

RPl 

TF  ( 

NRRT,?20) 

SETOOROO 
SETOOH 
SET006, 
SETOOfi* 
SET00640 
SETOOflSO 
SETOOA60 
s|T00870 
SETOObBO 
SET006R0 
SET00900 
SFT00910 
SET00920 
SET00930 
SFT0094U 
SLT00950 
SET00960 
SET00970 
SET00980 
SET00990 
StTOlOOO 
SETOlOlO 
SETO] 

tin] 

SETOi 
5ET01040 
SET01070 
StTOlOHO 
SET01090 
SFTOl  100 
SETOlllO 
SETO 1120 
SETOI 130 
SETOI  140 
5ET011S0 
St  TOllbO 
SETOI  170 
5ET0U80 
SET01190 
5ET01200 
5ET01210 
SET01220 
SET01230 
5ET01P40 
5ET012S0 
St  TO  126  0 
SET01270 
SETO 1280 
SET012O0 
5ET01300 
SET01310 
SET01320 
SF.T01330 
St  TO  1340 
SETO13S0 
SETO 1300 
SETOI 370 
St  TO  1 36  0 
SKT013R0 
St  T01400 
StT0l4l0 
Sf_TU14?0 
SET01430 
SET01<.4  0 
SET  I)  1 450 
SET01“60 
SFT01470 
SFT01450 
St.  TO  1400 
St  Toisno 
StTOlSlO 
SET01520 
St  TO  1530 
SF  T01540 
SETOlSso 
StTOlShO 
St  T01S70 
SETO 1500 


OK’':' 

OF  IK 


C 

c 

c 


??0  roPMftT(»  CrtPOH  ON  .»rtITe  FILE  CAHOO 
00  TO  lOS 

230  J » FINOl?(CARn.COL«EOOCOM) 

IF  < J .NP.  ?)  60  TO  215 

M « Nu»'RER(CARn,r.OLt6TRHU.ZER0) 

COL  a COL  - J 
60  TO  ?U 

240  J a FIN012<C«RO.COL«EOUCOM) 

!F  (J  .NP.  2)  GO  TO  215 
M a NUMf)ER(CAR0»C01..6T»lRF,2ER0) 

COL  a COL  - 1 
60  TO  214 


MASK  CARO 
330  M a NXTCHR(CARO.COL) 


333 

33S 

340 


.341 


J’’ 

34? 


r 

c 

c 


34S 

370 

3«0 


r 

c 

c 


60  TO 

340 

341 

342 


105 


TF  (M  .PO,  <<LNK  ) 

TF  (*'.F').P)  60  TO 
TF  (w.n.T)  60  TO 
IF(M.PO.Ii)  GO  TO 
WRTTF  {►'P^<T,33S) 

FORMATS  ERROR  ON  MASK  CARD  TRANSITION  YEAR  MASK  USED') 

GO  TO  34l 
MSKKPy  s ? 

no  20  Jal.lR 

TV(l.J>aRW31 (J) 

TY(?.J)aPH3?(J) 

TY(3.J)=Ph33(J) 

TY  »4, J) =PH34 ( J) 

TY(S.J)=PH3S(J) 

Ty (6. J) =PH36(J) 

TY (7. J) =Ph37 ( J) 

TY(P.J)=PW30(J) 

TY »Q,J) =PH3R(J) 

TY  ( m.  J)  SRH310  ( J) 

TY(11.J)=PH311(J) 

continue 

GO  TO  los 
MSKKPY=1 
no  10  I a 1,11 
no  in  j=l,i<3 
Uaj+io^-d-l) 

TY(I.J)=1 
IF(IJ/?*2.E0.IJ) 

COMTINlIt 

TFIGPOF.P'J.l)  GO  TO 
GO  TO  ns 
•"SKKFYrJ 
I.INF=L1NF*1 

IF(LI  JF.GT.1 1 ) GO  TO  333 
jsFiNOI 2<CAPO,COL,FOUCOM) 

IF(J.NF.2)  GO  TO  333 
NO^'SKaO 

NOMSPariiiy.-hR  (CARO, COL, MVEC»NOMSK) 

TF(NnYSK.(;T.  IP)  GOOFal 
IF  (NO'-<c<.GT.  19)  GO  TO  105 
00  T4S  J=1 ,AOMSK  • 

TV(LINF,J)='1VECU) 

CONT INUE 
GO  TO  ns 

OATE  CA-0 

M = t.xTrt'R(CAfto,coL) 

IF  ( .f  ).  PLNK  ) GO  TO  105 
RFAn(PPiJ.dT.3»^0)0ATE 
F0O»-‘aT  ( 1 0 < , 1 5A4  ) 
opwiMO  PrUNIT 
GO  TO  lOb 


TYtl, J)a2 
4M 


'-‘"'PO'" 


c 

c 


COMMFN'T  CARO 

?on  M s NYTCi^"' (CAWn,COL  ) 

IF  (P  . = 'J.  ••LUK  ) GO  TO 
PF  AOIRWuN  I T . "iFn)  COmENT 
PFWINI)  IvhU.>)IT 
GO  TO  ns 


105 


;K\L  PA(K.  ] 

H)R  QUA!  in' 

SET015R0 
SET01600 
SET0I610 
StT0)620 
SFT01630 
SET01640 
SET01650 
SET01660 
SET01670 
SET01680 
SET01690 
SET01700 
SE701710 
SET01720 
SET01730 
SET01740 
SET01750 
SET01760 
SET01770 
SET017R0 
SET01790 
SETOlflOO 
SETOieiO 
SET01820 
SET01830 
SET01P40 
SET01850 
SET01860 
StT01870 
5ET01880 
SETOlftRO 
SFT01900 
SFT01910 
SET01920 
SET01930 
SET01940 
SE TO  1950 
StT019b0 
StT0)970 
SET01980 
SET019Q0 
SET02000 
SET02010 
SET02020 
SE:T02030 
5ET02040 
SET020SO 
StT020G0 
SET02070 
SET02080 
SET02090 
SET02100 
SET02jl0 
SET  02 120 
SFT02130 
SET02140 
SET02150 
SET021G0 
StT02170 
ST  T02180 
SET02190 
SET02200 
StT02210 
SET02220 
SET02230 
SET02240 
SET022S0 
ST  T02250 
St  T02270 
St  T022R0 
St  Tn?290 
St  T02300 
SFT02310 
5LT02320 
SET02330 
St.T02340 
Gt.T0?350 
St  T02jfr0 
SET02370 


2X1^ 


UU  UU<J  UOU  iT- 


FIL»?1  SET19 


HEOl 

40n  M B NKTCHH<CARO*COL) 
--  — MEOI 


PEAn(RPUMT.3B0) 
R^W|p  RRUNU 


rO  105 


410 


500 


530 

520 

>♦ 


4?0 

430 

450 

A51 


HE02 

H < NXTCHkXCAROtCOL) 

PE40<RRiiNTT7380)  ME02 
PFWINO  RRUNIT 
60  TO  105 

CONVERT  CARO 

H»N«TChH(CARD»C0LI 
TP(*«,FR.RLNK)  60  TO  105 
IP(K.PO.FF)  60  TO  510 
WRTTF<NPRT.520) 

format <•  ERROR  ON  CONVERT  CARO') 

60  TO  105 

J=F 1 NO 1 2 ( C ARO « COL ♦ EOUCOM ) 

MsNUHRER<C»R0.C0L»6TN0F*ZER0) 

C0L»C0L-1 
60  TO  500 

*EN0* 

continue 

no  430  I=l»?56 
lF(TR'J^l(f).EQ.OQ)  60  TO  450 
CONTINUE 
60  TO  440 
WRITE (nRRT, 153) 

WRTTF (Ne«T,45i ) 

FOBH4T (//.l6x* 'DEFAULT  TRANSFORMATION  USED') 
C«LL  r,TT‘<N5 


440  CONTINUE 
C 

IFCGOOF.FO.n  60  TO  333 
no  450  1*1. 11 
pn  450  Jil.lQ 
IF(TY(I*J)  .FGi.-lOO)  600F»1 
IF(6noF.E0.1)  GO  TO  333 
450  CONTINUE 
461  CONTINUE 
C 

WRTTFINBRT.IOOO) 

WPTTE  (NPRT.noO)  GTROUtGTROF 
WRITP (nPRT. 1200)  6TWRU»6TWRF 
WRITE (nRBT, 1300)  6TN0F 
IF  (mskkEY  .FO.  1)  WRITE (NPRTt 1030) 

IF  (M5KKFY  .FQ.  2)  WRITE (NPWT, 1031) 

IF  (ySKKEY  ,r.O.  3)  WRTTt(NRWT,i032)  ^ 

1000  FORMAT (//•  USER  has  RKUUESTFO  THE  FOLLOWING  OPTIONS  :•/) 

1 030  FORM4TC  TRANSITION  YR4H  MASK') 

1011  FOOmaTC  phase  THREE  MASK') 
im?  FOpmaTC  input  mask') 

Iim  FOOMATC  RtA'Y  UNIT  s '.I3t»  READ  FILE  * '*13) 
ipop  FORMfTC  wOTTF  UNIT  = '*n**  WRITE  FILE  = ••.13)  , ^ 

1300  FOOMATC  THE  NUMBER  OF  TAPE  FILES  TO  RE  DUMPED  TO  DOT  FILES 
• 14) 

C 

WRITE (NPRT*530) 

530  FOP‘'AT(//*'  THE  CROP  CODE  TO  SYMBOL  TRANSFORMATION') 
PIRSTsl 

SYMzTONSl (1) 

, on  531  1=1.255 

IF  (TPNC) ( I > .np.Sym)  write (NPRT.632)  SYM.F IRST.LAST 
TFlTRMCim.NF.SYM)  FIRSTzI 
IF  (TRNSl ( I ) ,NF .STM)  SYMsTWNSl ( I ) 

IFU  .P  N.i'R5)  wH]TE(NPHT.532)  SYM.FIRST.I 

531  COMInUF 

63?  fopmatCh  .Sx.Al*'  = '*13**  « **I3) 

WRITE  (NPRT*»'40) 


= ' I 


SET02360 
5ET02390 
SIT02400 
SET  024 10 
SET02420 
SET02430 
SET02440 
SET02450 
Sf T02460 
StT02470 
SET024R0 
SET02490 
SET02500 
SET02510 
SET02S20 
5ET02530 
SLT02540 
SET025S0 
SET02560 
SET02570 
SET025M0 
SET02590 
SET02600 
Sf,  1 026 10 
Sfcf02620 
SFT02630 
SET02640 
SET02650 
SET02650 
SFT02670 
SET02680 
SET02690 
SF.T02700 
SET02710 
SET02720 
SET02730 
SET02740 
5ET027S0 
SFT02760 
SET02770 
SET027fl0 
SF  102790 
SET02B00 
SFT02810 
SET02820 
SET02630 
5F.T02840 
SFTOartSO 
SET02860 
SET02870 
SET028R0 
SET02690 
SET02900 
SET02910 
SET02920 
SET02930 
SET0PR40 
SET029S0 
SFT02950 
SET02970 
SEr029P0 
SF.T  02990 
S1.T03000 
SF.  TO.lOlO 
St  T03020 
SET03030 
SFT03O40 
SET030SO 
SET 03060 
5ET03070 
1SFT030SO 
ft|t'T03090 
St  TOllOO 
SFTOino 
St.T03120 
St  T03130 
St.T03i40 
St.T031S0 
SLT03160 


FILE!  S6T19 


ORIGTNAT.  PAGE  IS 
OF  PCOli  quality 


64«  format (//.»  THF  M4SKO 
^41  I»i.u 

W»ITE(NPkt»442) (TY(I«J) 
<S41  CONTINUE 
64?  FORMAKIh  *5Xfl915) 
RETURN 

• 

END 


SET03170 
SET03IF0 
SETOJ 
S|T0i 
S|T0i_^ 
SET03220 
SET03230 
SET03240 


22 . GTTCN  PROCESSOR 


FIl.Pt  OTTCN 


WlilTTFN  hv  c w AHttVS 

690U.!n  TwiiTu  TAHf  CONVEkSIOn  KOUTINE 

Sn^wr)^ITl^F  f.TTCN<AM«fty,TOP» 
l»“»Hr.IT  If>TrfiEM  (a-2) 
fli**ElvSTuM  AWkhV(I) 

CALL  FFT17 

CALL  TCN(AOWAV«T0P) 

RPTUO'J 

ENO 


r,TT0a0»0 

tiTTOOOPO 

<)TTO(iOiO 

GTT00040 

GTTOOOSU 

GTTOOdbO 

GTT00070 

6TTOOOAO 

6TT00090 

GTTOOIOO 

GTTOOllO 


FILfft  GTCRPL 


901 


9u2ilWT|Nt'^^?cS»»UcSo?fMT«NC) 

?M»»(  icit  lNTf(*FM  (A-Z)* 

COHMON^/8'T9K/NSoP.NP«T»P«TKEYtVLBI6)  .GTSOUtOTROF 
• .OTwBUtGTwRFfGTNOF 
WRTTF(WPRT»90n 
FOkHATUM  .10***GTCWPL») 

NC»0 


GTCOQOlO 

6TC00020 

gIcSISjS 

6TC0005G 


20 


10 


?o  10  I*!*** 

FULPCn.LT.l) 

--  ■•Tai 


60  TO  10 


Cf.«PT  (l» 

N«0 

on  20  J«1.0 
F(VLH(J)  .LT.n  GO  TO 
F(f.r,Fi),hT(j))  N«N*1 
.ONTINUE  » 
IFCk.LE.NC)  GO  TO  10 
NfaN 


20 


roOPaCC 

!F(NC.PE. 

continue 

RFTUHN 

ENO 


3)  RFTUPN 


GTCOOOGO 

6TC00090 

6TC00100 

GTCOOiiO 

GTC00120 

6TC00130 

GTC00140 

GTCOOISO 

Sflnhi 

GTCOOIPO 

GTCOOiOO 

GTC00200 

6TC00210 

6TC00220 

GTC00230 

GTC00240 


* 


fll.Fi  OTONPK 


\L  PAGK  !:■ 
Ul'  P*  ! '!l  (H-AI-!T' 


f 


9P1 

?n 

»« 


6TnNPKU04TA.N|»N2t0S.NRI»0S.LEN0TM> 
iMPUCIT  INTF.fiER  U-2J 

filH£N«;iON  IDATAMJ 
WRtTF  (^.«JPO) 

WRITF 

FORMftTdM  ,10X«»6TUNPK») 

DJ  10  I-l.NRPDS 

nn  ?f)  j«Ni»N2 

JJ«J*0S 

IF  (JJ.fiT.10<«>0)  WPlTE«6#90n  JJ 
1F(JJ.(“,T.10(^0»  STOP 

FnsMftT (irt  .lonf'jj-'tiioi 


n«in«TA(jj) 

IF(il.LE.12fl) 

gONT jNUf 
SsnS*LENGTH 
roNTi^uS 
HFTURN 
€•■'0 


ir)ATA(JJ)>10ATA(.JJ>-]2fl 

I0ATA(JJ)>128*I0ATA(JJ) 


6TU000 
GTUOOO^, 

GTUQOOSO 
QTU00060 
- 0 
0 
90 
00 


OTUOl 
GTUOOl 
6TU00 
6TUOO 
GTUOO 
GTUOO 
GTUOO 
GTUOO 
GTUOO 
GTUOO 
GTUOO. 
GTU00190 
6TU00200 


is 

30 

40 

5 

6 


7 

HO 


nup«  UNLAW 


c 


N01 

911 

9ft 

Aft 


3ft 

ftft 

C 

9ft? 


5UBR01JT 
f»»W  le- 
ft! HFN9 


INF  LINU8(/I0ATA/.MAXHEC» 
T 1NT»  r,EB 


. . JON  Hnft»,inATA(3090> 

•WtTF(3.9ftl) 

FORHATllH  «10«*'t.lNLA8') 
09*7? 

on  30  PlX*l«19ft 
O9«0S*2 
HbO 

40 


N«N*J 

rl^lss^6?®3^9ft) 


a9IT|I6»903) 
.ftOftOI  STOP 


sss 


|F»  _ 

IFISSS.GT  _ 
wPiiF  ^^♦9n3^  SSS 
Fn^^AKlM  .10X««SSS>«*I10) 

IF  <“.RT,M  'w«TTFI6»9U)  M 
TF  STOP 

roBMATUH  «lftXy  IN«««1S) 

MT  <**)«IOATAISSS> 

CONTINUE 
OS  *ns*Mn>OFC 
roNTiNUii 

d*LL  RTtfPPUCROP.MT.NCPOP) 

PPcP]K*7? 

PPcPTx 

TOftTft (PP)aCPOP 
0S=7?*?*P1X 
CONTINUE 
oo  ftft  I»2ft9. 

lOATA ( I) »0 

WRIT^•  (A.SOPI  ’04TAIK)  tS«I  .1961 
FObki\T(1m  •-^*1-) 

RFTUHN 

END 


MO 
0 

N00030 

NOOOaC 

NOOOSO 

NOOOSO 

NOOO’ft 

noooho 

N00090 
NOOf- 
NOOj 

30 
40 
NOOiSO 
NOOUo 
N0Q170 
NOOlAO 
N0O190 
N00200 
NOU2iO 
N00220 
N00230 


N002Se 

NOO^ftO 

IN00270 
N002A0 
N00290 
N00300 
IN00310 
N003FO 
Noono 

N00340 

N0O3S0 

N00360 


®^'G«VAL 
OF  POO/? 


PAOf  ,5 

^OAlrtY 


nu-'x  ^ETIT 


WPITTfK  bT  C - 

>rT17 

I*H‘»LlrIT  IUTKiPf  (•-/! 

ni*»FN«iinN  C"nF«lo»  «c*pd(6?)  tCoucoMO)  ,AC*Mni^o> 

niMFK'^tnN  bi 

nATA  SI  ASH  /!.•/•/ 

data  C"<(  t AHF».»»'€AO«t»WHIT»« 

• *rtPTI  * - ' )ATt--«  , tCOMH*  » ‘MEnl  • t *HEO?*  « ••ENO*  « »CONV*/ 
data  ► ',c , 

OATa  V/*y»/.‘'LNR^»  '/fU/MJV.FF/’F^/fOO/’O’/tP/'P*/ 
t'^CU'ilF  'Itl.lST 
tNCLIinF  CfST 

CO^H<A.,LI5t 
INfLUO^'  CHMKlft^LlST 
COMMON/ INFuhA«/M)CLS2j 


M»tL><rtNUSUR?.N0FET?.VA»SZ?»T0TVT?.N0FLn2. 
AVAH?.COVAH?,CLSIO?.SlHNO|»SUROS2.FLI>’'V?,VfWTX? 
FElvC?(?0)  t*;UHVC2(7S>  .‘^UhPThJTS)  .CLSVC?(60>  f 
KFPPTSIftO)  »N06«P.6HPNAH(t>0)  tGPPOEX  «6l » • 

• r-PPcHRlAl)  .GPOUhsupa) 
nrnFNMC'W  mFDI  US)  ,riiH?(lS>  «nATE<3»  »COHFNTnS> 

FOI'IVAI.FnCE  1*-Fni  < 1 > *mEaIMA)  ) • (UATFn  I .hFaD(22»)  . 

2 (HK{i?(l  ) «mEA0(30)  > » (COHtNTI  1)  tHE  AO(***>  » 

COHMON/'''LPBAL/hEaOI6?)  *MAPTAP«0ATAPF»SAVTAP«PHF  ILF*P*^FF.Y» 

• HIS^  Il..MIS^tY»TWFnPH.EP^PTP*F.«P<FY•HAPUNT.NOFlLF 

• nHiiMAOfnPl''*tiS«PAGSlZ»nATPlL»STAF  iLtASAVt  ASAVFl 

• .NHSTIjn,NhSTFI,SCT-UN«haPFIL 

• .OOTI'M.OOTI-  IL*NC«PAS»TONSFLtB*lTWFL.HlSTFl  .PCMUNTt 

• r-niJM«PHTUNT«l-AN|)IO 

COHmoM  /'»Tt'K/KP0«,NHPT*PRTKFY,VLB«6l  tGTPDUtGTROF , 

• r,TwHl),Gn»HF»r»TNOF 

common  /TAPrvn/IUNlTt  IFhST  .FSCAN.S*HF.NO»‘=iAMlNC.PFAnY.NSCAN. 

• I I''  c.  in  (200)  .DbL  »I.HnF  (30>  # JPEC  (30*  . IBYTE  (3(0  ,NHuFS.F  It  ENO.l 

• «LlNlNC*N*i«MP,NOCMANt  IFOHMT 

7F*»n  a <) 

NPPTaPwTUNf 

NPnWaOuOijNT 

OTPHUall 

f,TWkVll3l2 

r,T«iiP  «i 
fiTM^Frl 
r,T‘jOF»l 
NO'.  AH  * 0 
PPT«FY  a R 
^Pi)T  = lR 

r,T"0|fc  al 
NOCH.'iNsl 
irnWMTal 


CAFon 


f 

r 

r 


r 

c 

r 


iftp 


WPT  TF (NOW! .100) 
FO»“AT (/I  1 A. • '\PUT 


SUMMAhY*//) 


SET  UP  PEw£AO  «UFF£W 

PPHNIT  s '<0 

CAI  L PFPt‘iO(PI  UNIT. AO) 

PUT  CAPO  I».  luFFF^ 

j AR  PFAD (nPHP. 1 0 3)  ( ACAPO( I ) • 1*1 «?0) 

j 03  F OPPAT  ( ><OA<i ) 

upttf  (»PirlT.if>3)  (ACAPO(I)  .1*1.20) 

PfWlA'It  WP1I.11 

RFAO(PP')  1 I . 1 1 0)f out  1 .CAHO 
PF'.'JNO  wPii^IT 
fOI  a o 

PPTTF  ('JPUI  , 1?<1)  fuOF  1 .CAPf) 
l?n  FORMAT  ( 1 * .A- .OVA  1 ) 

ITO  FOP  '!>  T ( Ap  . o < ,fi?  4 1 ) 

00  1 ■><'  1:1.  iP'l  f 

IF  (COOF  1 .F.  ).f Ollf  ( 1 ) ) 'iO  TO 


r 

r 


lift  rONTINOF 

j u p 1 TF  ( ' -<«  T . 1 P'O 
140  roNMft I ( • I NVAl lU 

r.o  T')  l ip 

LAP(I  VfCINi. 


( ISO.IHO.AIO.330.370, 
300. 400. 410. <20.®.  (1*1), I 


CON T POL  CAPO  - lONOPFO  •) 


SF  TOOOlO 
Al T00020 
SE  T00030 
«;etooo4() 
SfcT000*'0 
SfTCOOftO 
Sf  T00070 
SET0o()rt0 
SFTOOilNO 
StTOOlOO 
SFTOOiio 
SET00120 

A.FTOOISO 

• SETOOlF-O 

Sf Tool  70 
SETOOlHO 
SFTOoiNO 
S£T00?0() 
SET  002 10 
SET  00220 
Sf  TP0?30 

. SFTOOZ40 

SETO02''O 
SCT002S0 
St  TO02TO 
StTOOPPO 
SFT002V0 
SET  00300 

stTcoaio 

INFNpSf T00320 
SFT00J30 
S)  TOO-Tuo 
SF  T n03MJ 
StT0(i3P0 
SFTO0J(O 
SF  T OO'UU) 
Sf T003P0 
SF‘TO')4(iO 

SET  004  10 
Sf  to04?0 
SF  T00410 
Sf  T00440 
SF.TO04S0 
SF  T004NO 
SF  T004  70 
f F T004SO 
SF  T 004PO 
Ff  TOOSOO 
Sf TOOSIO 
SF  TOOS'^O 
SF.Tn0S.10 
St  T00S40 
TOOSSO 
Sf 1 nOSOC 
Sf  Tons  70 
Rf  1 nos«o 

SF T nos  >n 
sf  1 oOMfO 
SF  TOOOl'/ 
SF  Toos2o 
SF  1 1)0M0 
T onsud 
St  1 dOSPO 
u f 111  Itp/'U 
* t r d (»?^  / n 
Sf  1 (lOfifd 

Sf  t ofi'i'-t, 
SF  T f'l)T  Ui 
SF 1 00  7 1 n 
Rf  ion  / 

Sf  T 1,1)  r ui 
SF  T 00  7-.0 
SF  T('0  /‘-.o 
S'-  1 on  7.m» 
s>  T I 0 7 / 0 
Sf  1 I u / (I 
Sf  I 01'.  f /O 


riLFi  SCTI7 


1^0  * ■ N«TfH»*<f*wn.COU 


r 

f 


1^? 


i«o 


ir  6u  ro 

If  00  to 

rnOM*T(»  »>P0M  on  L*HFL  CAPO') 


to  lOS 


00  to  1ft*) 


j ■ rino]2(c*pn,coL*EOucOM) 
Tr  tj  .nF.  >1  FO  TO  15? 

NOI  AO  ■ MJHOFMlCAPn*CdL«Vt.F 


OO  TO  105 
PFAO  TAPE 


IL«Vt.O«NOt.AB} 


JA5 

lAT 

19ft 


2ft0 


M > nxrcHHtCAKOtCOU 
!F  (M  .FtJ.  pCh*.>  go  to 
TF  Jw.f'l.yJ  no  To  TVO 
IF  i‘ufM,fh  00  ■ 

wPtTF (MpPT*i AT) 

FOO*«AT(t  CkPnb  r 


105 


TO  200 


rOp««At(»  Eppop  ON  HEAD  Tape  carom 

no  TO  1^5 

J a FIMOl?(CAP0.rOL,COUC0P» 

TF  (J  .*-F.  2)  no  to  lAN 
H s NUMHtP<CAPO.COL»OT‘<OU*ZeRO» 

COL  « ruL  - 1 
no  TO  1-ft 


J « FIN01?(CAP0»COLiEOgC0M» 
IF  < J ,NF.  2 ) GO  TO  1H5 
M ■ ^'UMHEP)C^H•).C0L^GT40F#7 


COL  « rOL  - I 
no  TO  iho 

WOITE  tape 


ZERO) 


21ft  CONTINW* 

21*  M ■ NXTChp(CaPO«COL) 

IF  (M  .Fy.  mLNK  ) GO  TO  105 

IF  <*'.f!j.u)  no  rn  230 

TF  (•‘.f'.'.FF)  on  TO  2A0 
215  wpt  TF  )*‘||.mT.220) 

22ft  FOomaTC*  E*<Poy  ON  WRITE  Tape  CAROM 

no  TO  i»is 

2Tft  J « FlN01?(CAROtCOL.FOgCOM) 

TF  ( J .NF,  2)  GO  TO  215 
H « MjPHFw iCAKn»COL*GTwWUtZEPO) 
roi  » rf>i  - 1 
an  TO  2lA 

2*ft  J « FI!.«Sl2<CAftO.COI,,FGUCOM) 

TF  ).J  .'F.  2)  on  TO  21s 


**  m NU‘“<iy)rA*<ntCOL.GfwPF./ER0) 
COL  » COL  - ) 

no  TO  2) A 


option  CARO 


33ft  ••  a N)  TC*«w  (Cr  «n.cni  ) 

IF  (M  ,m;.  ).  (,0  TO  lft5 

TF  (‘■.Fi.,P)  (,n  Tti  3*0 
333  woi  T»  (*  • -IT  . 33->) 

335  FnP«AT<*  FnPOP  i)N  OPTION  CAPOM 

r.n  TO  1 'fi 
3*0  PPT*'>^y  « 1 
no  TO  1(5 


OATt  CA-’O 


170  M n N*Tr*-‘tf  AWn.COL) 

TF  ( « .fii,  ^LNO  ) GO  TO  105 

T.  H*.))rATE 

1*0  rno^»4T  ( l<ix,  )tA*| 

OfylMi 

no  TO  If'S 
CO^NfNT  CAWO 

loo  M , ) » Tr«- (Ct-"'.Coi  I 

TF  {>*  n 'J"  ) I'O  TO  IftS 

pr />()  (rW  H.  ! I , 0)  NT 

PFwl^  It  whi;  4 1 r 


SFTOfiHOO 
)Gnto 
)CH20 
. >0  >3' 

, TOO  •* 
STftO*‘5 
joONGO 

■tOOAT 
StTCOfA 
sfTOOAP 


SiTOOVOO 

lit 


TOOGj 

SET"OR< 

SFt(l0910 
5tT009Ag 


W 

sr- 


950 
.950 
.00970 
TQ09A0 
T009PO 


_T0 

MO 


ftTOlOPft 
5M0i03O 
"10*0 
1050 
106ft 
IU70 


SMft 
ftTo! 
SfTOl 
51  TO! 


ST  Tftl0»*0 
SETOIOPO 


5f  7013^0 
5FT01330 
5M01  3*0 
SI T 01 350 
SM‘>1  3**0 
Sr  T01370 
5).T013-i0 
5M  0 1 3 » I) 
51 T01*0n 
5)  T 01  *.10 
SI T01*20 
51  T 01*  30 
SI  T(il**(i 
*«1  T01*S0 

Si  TO  1 *,M) 


SI  TO 
*■)  TO 


1 * 

, H 


*7U 

f'  0 


St  Tni*>.,i 
SI  I Olson 
SI  TO  IS  I ft 
StTOI 
St  1 n 1 


S.>0 
S-tO 
->t  T <'  is*(( 
Sf  T(  Is^'u 


S)  Ti'l 
T"1 


SI) 
rti 

St  TftlS'iO 


PIl  P:  «;FT17 


60  TO  los 

C 

c 

C HEOl 

c 

400  M a N»TCH*<(C«fJO.COL) 
RE4n(OPU.MlT,'?flO)  mEOI 
OEWIijn  RPUNTT 
60  TO  lOS 

C 

C HEO? 

C ' 

410  M = NXTCHK(C*RDtCOL) 
PEar>(RRU\IT.3<in)  HED2 
REWIND  RH'JNIT 
60  TO  ms 

c 

c CONVERT  CARO 

C 

«;on  M=NXTrHR(CAPO»coL) 

TE(R.i^rj..-.LNK)  GO  TO  105 
IP(N.P.j.FF)  60  TO  510 

^■^0  WDITP  (NRRT,S?0) 

5?n  FORMAT <•  ERROR  ON  CONVERT  CARD*) 

GO  TO  105 

510  J=FIMni2(CARO.COLtEOUCOM) 


rv-’  rP^^AL  PAGTS 


c. 

c 

r, 

4?n 


4 30 


450 


c 

440 

r 

r 


1 000 
1010 
1030 
1 100 
l?on 
1 300 


MrNUMRFR (CARO. COL *GTNOFt ZERO) 

C0L=C0L-1 

GO  TO  500 

•END* 

rONTIMUF 

TF  (NOLAB  .NE.  0)  GO  TO  440 
no  430  1=1.5 
VLP(l)  = 1 
FONT INUE 
NOI  AP  = 6 
GO  TO  440 
wRITF(.\rrT.153) 

NOLAW=n 
GO  TO  ^20 

CONTIMI.iF 

IF (NOLAH.lt. 5)  GO  TO  450 


WPTT>^  (N 
WPTTF  <ro 
WPTTF ( 
WPITP  ( 
WPl TF  ( 
TF  (P-T 
FORMAT ( 
FO'^fAi\T  ( 

form  ^T ( 
FOR*V.T  ( 
FOR‘'AT 

FORM  (\  J 


HRT 
‘•(•T 
■ P 
’ P 
' >1' 
''EY 
//' 
• T 

I p 
I 

{ ' 

r I 


inoo) 

1)00)  GTkOU.CiTROF 
T.1200)  GT'fPU.GTWRF 
r.1300)  GTNOF 
T.IOIO)  ( VLH ( I ) . 1=1 .6) 

,F0.  1)  wrTTE(NRRT,1030) 

USER  HAS  RFUUESTEO  THL  following  OPTIONS 


,-iF  LAPEL  vector  is  = *.613) 

RTmT  the  2(1r  DOT  LAHELS') 

Ef.n  i.iNlT  = *.I3.'  READ  file  = *.I3) 
'•mITP  UNIT  = *.I3.*  WRITE  FILE  = ».I3) 
ThF  NLIM.PFR  OF  FILES  TO  BE  CONVERTED  =• 


! •/) 


,13) 


RETURN 

FNO 


SETOISRO 

SFT01600 

SET01610 

SET01620 

SET01fe30 

SET01640 

SET01650 

SET01660 

SET01670 

SET01fat*0 

SF.T016RO 

SET01700 

SF.T01710 

SFT01720 

SET01730 

SFT01740 

SET01750 

SET01760 

StT01770 

SET01780 

SET01790 

SETOIBOO 

SET01810 

5ET01B20 

SET01830 

SET01840 

SETOlftSO 

SET01M60 

SET01H70 

SET018B0 

SFT01B90 

5ET01900 

StTD1910 

SET01920 

SET01930 

SET01940 

5FT01V50 

SLT01950 

SLTC1970 

SETOlPfiO 

SET01990 

SET02000 

SET02010 

SET02020 

SET02030 

SLT02040 

SET02050 

SET020n0 

5ET02070 

SET020BO 

SET02090 

5ET02100 

SFT02110 

SFT02120 

SFT02130 

SETO?i40 

SET02150 

SFTOJlnO 

SET02170 

SETO21B0 

SET02190 

5ET02200 

StT0?21(i 

SET02220 


no  non 


file:  TCN 


WRITTEN  BY  C w «HLCPS 
SUBROUTINE  TCNURRAY»TOP» 

IMPLICIT  INTFGEK  (A-Z) 
ni»FNSION  AORAY(l) 

LOOlCAL^l  V»L(?400) .lOLtflOO) 

OI*^ENSION  lUATAl  (3060) 

OImfnsION  IPUF(76*i) 
ni'^FNSTON  FFTVECOO) 
data  FFTVEC/3P»0/ 

OTRFN^ION  inATA(3060) 

DIMENSION  RL0C<(61 

common  /tapfro/  iunit,ifrst«fscan,sameno.saminc«ready»nscan, 

* 1.  INC. 10 (POO) .OSL.LbUF(30) . JREC ( 30) . I0YTE ( 30) .NflUFS.F ILENO.L 

* .LlNINC.NSAMP.NDCMAN. IFOBMT 

COMMON  /WRT tP/TCOONT.FOHMT .UNIT tVARBL (600) tlREMO 
FO'lTVftLENCE  (VPL,VAM0L) 

EQUIVALENCE  (ID.IDL) 

LOC'ICAL*)  DY(4)  ,MN(4)  .YR(4)  »ST(4) 

FOHJ VALENCE  (OeY.OYn  ) ) t (MON.MNd)  ) « (YEAR.YPd)  ) . (SITE.STd) ) 
EOI'IvalEnCE  (DAY.OY) * (MON.MN) « IYEAR.YR) . (SITE, ST) 

COMMON  /'■.TRK/NHt)R,NPRT»PRTREY.VLB(N)  .GTRDU.GTROFt 

* GTWPU.GTWHE.GTNOF 


(tnaTAd)  .ARRAYd)  ) 
dOATAl  d)  • ARRAY  ( 3061 ) ) 


EDUTVALENCE 
EDO I valence 

UNIT=GTxUu 

TUNITsfiTRDU 

eodmt=tformt 

NCOE=0 
FTLP=0 
NOCHAN=l 
N0'"PAT  = N0CHAN 
EETVECd)=l 
7ERO=0 
0UTPX=)06 
TNPX=30p 
0Sf:  = 7? 

OME=l 

GTfjppf)  = 3 

HL.)rxd)=i 
BLOCK  (?) =3S1 
RLQCK(3)=l 
Bl.QCx(A)=l 
; FLOCK (S) =39? 

BLOCK  ('>)=! 

i 10  continue 

pPWliir)  GTPOU 
PE WIND  GTwNU 
RnE  = r,TRDE-l 
PRF=GTwRF-1 

CALL  Ef.FMFL  (GTWPU.viRF.  ISTATW) 

«:  10  CONTINUE 

I»Fr=n 

j ICnu^.T  = 0 

NPFC=n 

; EILE=FILE*1 

OAY  = 0 
i MOM=0 

1 YEAft=0 

i SITF=n 

CAIL  TAPHORIGTRO'J.ROF) 
r)AY=in  (?^) 

! M0N=Tn(?6) 

1 YEAR=in(?7) 

'•  SITE=I0(2A) 

1 VHL ( 73) =IDL (1 00) 

VBl.  (74)  =10L  ( 104) 
i V«L (7S) rlOL (lOP) 

VBL(7Q)  = inL(in) 
i VWl (AO) =I0L (11?) 

-I  CAIL  wPThFD (NOEEAT.FETVEC.OUTPX.EORMT.GTWRU) 

i GTPFr=S40 

; WRITE  ('jPFT. bill  ) GTRf’F.GTWRE 

fOl  FOmmati  //,•  FIL*-  * . I4.6X, 'PEING  CONVERTED  TO  FILE 
; wPI  Ti-‘  ( nPRT  . ?o  ) b I TE  .nay  .MON.  YF  AR 

llo6  FOW.><AT('  SITE  = • , I S » Sx  . ' 0 A Y = • , I S . SX  , • MONTHS  • . I S , SX  . 
. • •Yf.AR=».IF) 

, IF  (PPTaEY.Fi).  1 ) WRITE  (NRPT  ,b00) 

’•  CALL  FLOIUT  (HI  OC^  .EETVEC.NOFE  AT) 


14) 


TCNCOOlO 
TCN0C020 
TCN0003C 
TCN00040 
TCNOOOSO 
TCM00060 
TCN00070 
TCNonoeo 
TCN00090 
TCNOOlOO 
TCNOOllO 
TCN00120 
INENOTCNO0130 
TCN00140 
TCN00150 
TCN00160 
TCN00170 
TCNOOIBO 
TCNOOlOO 
TCN00200 
TCN00210 
TCN00220 
TCN002a0 
TCN00240 
TCN00250 
TCN00260 
TCN00270 
TCN002RO 
TCN00290 
TCN00300 
TCN00310 
TCN00320 
TCN00330 
TCN00340 
TCN003SO 
TCN00360 
TCN00370 
TCN00380 
TCN00390 
TCN00400 
TCN00410 
TCN00420 
TCM00430 
TCN00440 
TCN00450 
TCN00460 
TCN00470 
TCN00480 
TCN00490 
TCNOObOO 
TCNOOblO 
TCN00?>20 
TCN00530 
TCN005)40 
TCN005S0 
TCN00560 
TCN00570 
TCNOObBO 
TCN00590 
TCN00600 
TCN00610 
TCN00620 
TCN00630 
TCN00640 
TCK00650 
TCNOOhbO 
TCN00670 
TCNOObBO 
TCiNOObPO 
TCN00700 
TCN0071  0 
TCN00720 
TCN0073U 
TCN00740 
TCN007SO 
T(.N007bO 
TCN00770 
TCN007rtO 
TCN00790 


FILFt  TCN 


Of'S?Ai 


(SftO  FOpyaTO  THE  209  DOT  LAdELS*) 

?«  continue  . . 

00  «01  J«1.3 
1PFC*IPEC*1 

TFC1PEC.6T.9LOCKC2) ) 60  TO  50 
call  LINEPOnOATAl.ENOTAP) 

IF(EN0TAP,E0.-1>  60  TO  50 
00  flOO  I *1.6TPEC 
JJ=I*GTREC*<J-1)*72 
IOATA{.JJ)slOATAl  (I» 

CONTINUE  , 

CONTINUE 
NFOFsO 
NPEC=NREC*1 
0566=056 

CALL  6TUNPK(10ATA»0NEt0UTPX.0S66»GTNRPDt6TPEC) 

IfTnPFC^LE.?)  write (NPRT.P50)  ( lOATA (K) *K*l ,63) 

FOPvsTUH  .1514) 

CALL  LINLAB<10ATA.6TRECI 

N10=MnO(NWFC. 10)  

: IF(NREC.EO.l)  WRITE «NPRT*ft50)  ( lOATA (K) *K=1 »6TREC) 

CALL  WRTLNI IDATA.ZERO) 

IF (PRTKEY.EO.I.ANO.NIO.EO.O)  write (NPRT»839)  ( IOATA ( I ) ♦ I =10* 190 

♦ .10) 

A39  F0«MAT<IH  *5X*19I5) 

GO  TO  20 
SO  CONTINUE 

FNOFILF  gtwru 
WRTTF  (MPRT.700)  N'REC 

700  FORMAT  (•  NUMBER  OF  SCAN  LINES  )»R1TTEN=' . 15) 

WRITE (NPRT. 750)  GTR0F.6TwRF  „ 

7S0  FOPMATC  FILF  »»IS.5X»»WAS  CONVERTED  ONTO  FILE  '»15) 
6TPr)F=GTP0F*l 


POO 

601 


«S0 


ROF=PnF*l 

GTWPF=GTWPF*1 

IF<FILF.LT.GTNOF)  GO  TO  10 
FNDFILE  GTwwU 
PFWTMD  GTRf'U 
RFWINn  GTWPU 
WRITE (NPPT.PSn) 

FORf^ATC  PROGRAM  GTTCN  RUN  COMPLETED') 

RETURN 

END 


TCN00800 
TCN00810 
TCN00820 
TCN0083C 
TCN00840 
TCN00850 
TCN00860 
TCN00870 
TCN00880 
TCN00P90 
TCN00900 
TCN00910 
TCN00920 
TCN00930 
TCN00940 
TCN00950 
TCN00960 
TCN00970 
TCN009H0 
TCN00990 
TCNOIOOO 
TCNOlOlO 
TCN01C20 
TCN01030 
TCN01040 
TCN01050 
TCN01060 
TCN01070 
TCNOIORO 
TCN01090 
TCNOllOO 
TCNOlllO 
TCN01120 
TCN01130 
TCN01140 
TCN01150 
TCNOllftO 
TCNOl 170 
TCNOl 180 
TCNOl 190 
TCN01200 
TCN01210 
TCN01220 
TCN01230 


S/3 


23.  TESTS?  PROCESSOR 


FILE  TESTS? 


8: 

c* 

c* 

c* 

c* 

€♦ 

C* 

C* 

c* 

c 

c 

c 

c 


SUBROUTINE  TESTS? (ARRAY* TOP) 


THIS  program  performs  a modified  version  of  THE  CLUSTERING 
AL60RITM  (ISOOATA)  OWlGlNALLY  DEVELOPED  BY  BALL  AND  HALL  OF 
STANFORD  RESEARCH  INSTITUTE.  THE  ALGORITHM  MAS  BEEN  MODIFIED 
ON  THE  recommendations  OF  ED  KAN  (LEO. 

THE  PROGRAM  EXPECTS  MULTISPFCTRAL  SCANNER  DATA 
IN  either  .the  LAHSYS  22  OH  THE  UNIVERSAL 

format,  the  data  tape  SHOULD  BE  ASSIGNED  TO  FORTRAN  UNIT  3. 


implicit  INTEGER  (A-X) 

INCLUDE  COMHKS.LIST 
INCLUDE  COMNTS.LIST 
INCLUDE  C0MHK6.LIST 
INCLUDE  CMRK16.LIST 

COMMON/PASS/STOP. LNCaT*NMIN.KRN»STDMAX*OLMIN. SEP* 

• MAP.SPTRIG*  iro.  kpts*  nopts*  punch* 

• 1CHN*CHNTMS*1CHAIN<62)  *Nk.*DS*  IREGIN*BEGIN1  * 

* BEGIN?*BE6IN3*CLSNaM*N0FLD* lPt*TOTWRO*TOTPTS* 

• NCLASS»NOCL5*TOTSUR.TOTFLD*TOTVRT*NOCL*NVRT 

* *NXTCLS.NOFEAT«haXCLS.FFTVEC(30) *SYMMTX(62) 

♦*VARSIZ*STATKY. isokey. MAPFMT.HAPKEY*SEOUEN(20) *percen*simerp 
*.I0R0EP.INIJNIT.InFTLE*INITM*PMIn*SUBVEC(62) *NOSUB2*CHNVC(30) 

♦ *NOCHAN,EPCOmP.NOSEO»MEANOO*MEANOU* 

♦ S YMOO • S YMDU  * I TH I GO  * I TR I GU . DOF  L AG* 

• DUFLAG*OODU*STDOTS(60) *NSD0TS*SUNC0R(30) *llncat* 

* OVERT  (250,2)  *DHECT(60,2)  *OVPNT  (U*2)  *I0CNT(2)  *N00U(2) 

* .MXFETl.MAXPOP 
REAL  SUNCOH 

•PASS*  IS  USED  ONLY  BY  THE  ISOCLS  PROCESSOR. 


c* 

c 

COMMON  BLOCK 

c** 

C* 

ISOCLS  USES 

c* 

c* 

c* 

SEE  DEFINITI 

DEFINITIONS 

c* 

c* 

ISTOP 

^ 1 

c* 

c* 

LNCAT 

^ , 

c* 

s* 

NMIN 

c* 

c* 

KRN 

^ 1 

c* 

c* 

STOMAX 

c* 

c* 

OLMIN 

^ 1 

c* 

SEP 

w 1 

c* 

c* 

c* 

Map 

1 

i 

c* 

SPTRIG 

•* 

c« 

IRD 

••  1 

c* 

c* 

NOPTS 

•• 

5* 

CONTINUE 

KPTS 

c* 

PUNCH 

• 

c* 

c* 

ICHN 

c* 

CHNTHS 

— 1 

c* 

ICHAIN 

NWDS 

c* 

c* 

IBE6IN 

*•  i 

e: 

BEGINS 

1 

c* 

c» 

BE6IN1 

\ 

MAX.  NO*  OF  ITFRATIONS  FOR  THE  CLUSTERING  PROCEDURE 
SET  IN  SETUP?  ROUTINE.  (USER  INPUT) 

CURRENT  NO.  OF  CLUSTERS.  SET  INITIALLY  IN  ROFILE  OR 
ISOCLS.  then  ONLY  IN  ISODAT. 

MIN.  NO.  OF  POINTS  TO  ALLOW  PER  CLUSTER 
SFT  IN  SETUP?  ROUTINE.  (USFH  INPUT) 

PRINT  CLUSTER  SUMMARY  EVERY  ‘KRN*  ITERATION(S) 

SET  IN  SETUP?  ROUTINE.  (USER  INPUT) 

STANOapD  DEVIATION  FOR  SPLITTING  CLUSTERS 
SET  IN  SETUP?  ROUTINE.  (USER  INPUT) 

MIN.  distance  BETWEEN  CLUSTERS  FOR  COMBINING. 
distance  TO  SEPARATE  CLUSTERS.  SET  EI6HER  IN  SETUP?* 
BY  USFR  INPUT,  OR  IN  ID 
PY  USER  INPUT,  OR  IN  ISODAT, 

PRINT  A CLUSTER  MAP  EVERY  'MAP*  ITERATI0N(S)-_SETUP? 


TCSOOOlO 
TES00020 
••TES00030 
TESOOOAO 
TES00050 
TCS00060 
TES00070 
TES00080 
TCSOOOPO 
TESOOlOO 
TESOOllO 
TES00120 
TES00130 
••TESOOIAO 
TES00150 
TES00160 
TESOOiTO 
TESOOIBO 
TES00I90 
TES00200 
TES00210 
TES00220 
TES00230 
TES00240 
TES00250 
TES00260 
TES00270 
TES00280 
TES00290 
TES00300 
TES003ID 
TES00320 
TES00330 
TES00340 
TES003S0 
TES00360 
TES00370 
TESQ0380 
TES00390 
TES00400 
TES00410 
TES0042C 
TES00430 
TES00440 
ISTES00450 
TES00460 
TES00470 
TES004S0 
TES0049C 
TESOCSOO 
TES00610 
TES00520 
TES00530 
TES00540 
TES00550 
TES00560 
TES00570 


- TRIGGER  TELLING  WHETHER  OR  NOT  *SEP*  WAS  INPUT.  -SETUPTES00580 


NO.  OF  RECORDS  TO  READ  FROM  DATA  FILE,  COMPUTED  IN 
ISOCLS 

NO,  OF  POINTS  IN  EACH  RECORD.  COMPUTER  IN  ISOCLS 

NO.  OF  POINTS  IN  LAST  RECORD.  COMPUTER  IN  ISOCLS 
TRIGGER  TELLING  WHETHER  OR  NOT  TO  PUNCH  THE  MODULE 
STAT  deck.  - SETUP? 

TRIGGFR  TELLING  WHETHER  OR  NOT  CHAINING  IS  TO 
MIN.  DISTANCE  BETWEEN  CLUSTERS  FOR  CHAINING  - 
ARRAY  CONTAINING  CHAINED  CLUSTER  NUMBERS.  SET 
•CHAIN*  ROUTINE. 

TOTAL  NO.  OF  WORDS  AVAILABLE  FOR  DRUM  STORAGE 

Image  data  to  be  clustereu  - set  in  isocls 

BEGINNING  DRUM  FILE  ADDRESS  FOR  INPUT  INITIAL  CLUSTER 
centers  - SFT  IN  ISOCLS 

BEGINNING  drum  FILE  ADDRESS  FOR  TEMPORARY  STORAGE  OF 
CLASS  STATISTICS  - SFT  IN  ISOCLS  ROUTINE 
beginning  drum  FILE  ADDRESS  FOR  IMAGE  DATA 


BE  DONE 

SETUP? 

IN 

OF 


TES00590 

TES0060Q 

TES00610 

TES00620 

TES00630 

TES00640 

TE500650 

TES00660 

TES00670 

TES00680 

TES00690 

TES00700 

TES00710 

TFS00720 

TES00730 

TES00740 

TFS00750 

TES0076C 


FILE  TESTSF 


BEGIN2  - beginning  DRUM  FILE  ADDRESS  FOR  ‘IPLACE*  .(CLUSTER  TO  JESOOTTO 
WHICH  CORRESPONDING  POINT  BELONGS.)  III22J2? 

CLSNAM  - NAHE  OF  CLASS  CURRENTLY  BEING  PROCESSED.  - ROOATA  TESOOTff 

- NO.  OF  FIELDS  INPUT  FOR  This  CLASS  - ROOATA  ^ 

- NO.  OF  WORDS  OF  storage  USED  IN  ‘ARRAY*  FOR  FIELD  AND 

CLASS  INFORMATION  FOR  THIS  CLASS.  - ROOATA  

- TOTOL  WORDS  WRITTEN  ON  DRUM  FILE  BEGINNING  AT  ADDRESS 
BfGINl  • ROOATA 


TOTWRO 


TES0084I 


T6T0L  POINTS  TO  BE  CLUSTERED  FOR  CURRENT  CLASS  -^RDOATTESOefS 
NO.  OF  CLASSES  TO  BE  CLUSTERED  FOR  CURRENT  CALL  TO 
ISOCLS.  USER  INPUT  - SETUP?. 

CURRENT  CLASS  NO.  - ISOCLS  _ _ 

total  CLUSTERS  FOR  THIS  CALL  TO  ISOCLS 
TOTAL  FIELDS  FOR  ALL  CLASSES  - ISOCLS 


:•  TOTPTS 

;*  nclass  - 

:*  NOCLS  - 

:*  TOTSUB  - 

;*  TOTFLO  - 

!•  TOTVRT  - 

:*  NOCL 

IEV033I  comments  

C0MM0N/6L0BAL/HEA0(63> .MAPTAP.OATAPE.SAWTAP.BMFILE.BMKEV. 

HISFIL.MISKEY.TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILE* 
DRUMAO.DRMwOS.PAGSIZ.DATFILtSTAFIL.ASAV.ASAVFL 
.NHSTUN.NHSTFI.SCTRUN.MAPFIL  

.DOTUNT.OOTFIL.NCHPAS.TRNSFL.BMTRFL.HISTFL.PCHUNT. 
C0MM0N/IS0LNK>SUNAN6(8) »ISUNT»ISUNC.SMSTR«SMSTP*SMINC*LINSKP 


CSENO 


C* 

8: 

j: 

c* 


210 


•/.SYMOB  /•#  •/ 


TESOt- 
TESOOBTd 
TES00880 
TES0OB9O 

TOTAL  FIELDS  FOR  ALL  CLASSES  - ISOCLS^  TES0090Q 

TOTAL  VERTICES  FOR  ALL  FIELDS  ISOCLS  III22oIa 

NO.  OF  CLASSES  SINCE  LAST  CALL  TO  SETUP  - ROOATA  TES00920 

OELEnO 

TES012JO 
TESOl* 
TESO 

T«0l_  - 
TES012S0 
TES01260 
TES01270 
TES01280 
TES01290 
TES01300 
TESOl3iO 
TES01320 
TES01330 
TE50I340 
TES01350 
TES01360 
TES01370 
TESO 1380 
TESO 1390 
TES01400 
TES01410 
TES01420 
TES01430 
TES01440 
TES01450 
TES01460 
TES0U70 
TES01480 
TES01490 
TES01500 
TESOlblO 
TES01520 
TES01S30 
TES01540 
TES01550 
TES01560 
TES01S70 
TES01S80 
TES01590 
TES01600 
TES01610 
TES01620 
TES01630 
TES01640 
TES01650 
TES01660 
TES01670 
TES01680 
TES01690 
TFS01700 
TFS01710 
TES01720 
TFS01730 

tlsoitao 

TES01750 
TF.501740 
TES01770 
TES01780 


DIMENSION  KVARf 11500) 

KVARDM  s U500 
DIMENSION  ARRAY! 1) 

DIMENSION  C0VAR(465) 

DIMENSION  NN(60) 

DATA  SYMDA  /»* 

MAXP0P=62 
MXFETU30 
IBEGIN^ORUMAO 

RESERVE  ENOUGH  DRUM  STORAGE  FOR  MAXIMUM  INITIAL  MEANS 

BE6IN3=IBE6IN  ♦ MAXP0P*HXFET1  ♦ MXFETl  ♦ 2 

CALL  SETUP  TO  READ  CARO  INPUT  AND  INITIALIZE  DEFAULT  VALUES 

ITIME=1 
NOCLS  3 0 
TOTFLO  = 0 
TOTVRT  = 0 
TOTSUB  » 0 
C0PBAS=1 
ITRIGU  a 0 

|tpigo=o 

SYMDO  * SYMDA 
SYMOU  = SYMOB 
MEANDO  = 0 
MEAHOU  = 2S5 

CALL  SETUP7 (ARRAY (CORBAS) .TOP. ITIME) 
lOUM  = MAXCLS 
IFdTIME.GT.DGO  TO  2 

VARSIZ=N0FEAT*(N0FEAT*l)/2  . , 

REGINI  = BEGIN3  ♦ NCLASS*MAXPOP* ( VARSIZ  ♦ NOFEAT 
NWDSsDRMWDS- (BEGIN! -DRUMAD) 

ITIME=ITIME*1 
NOCLsO 

CALL  ROOATA  TO  COORDINATE  READING  OF  DATA 

MAXOIM  = T0P-C0R8AS 
FOlsCORHAS 

CALL  RDOPAT  (FDl  .MAXOIM. KVAP. I- VARDM, LAST) 

MAXCLS  = lOUM  ♦ OODU 

WHITE(4.210»  NDO'in  » .NDOU(?)  „ „ , 

FORMAT (IX. //•  00/DU  CLUSTFW  POP  FOR  THIS  CLASS  ' 

HF61N2  = BEGIN!  • (TOTWRD/4)  ♦ 2 
N!  * FOl  ♦ IPT 
MEANS1=N!  ♦ MAXCLS 
ST0EV!=MEANS!  ♦ MAXCLS*N0FFAT 
TTOP  = STOEV!  ♦ MAXCLS*N0EEAT 

maxoim=top-ttop 


♦ 1) 


>217) 


POOR  QUALITY 


FILE  TESTSP 


500 


NOPTS  « MAXDIH/(NOFEAT«n 
NOPTS  ■ (N0PTS/4)*4 
PART  OF  PACKING  CH6  SEPT  1976 
IDATl  * TTOP 

IF  (NSDOTS.EO.O)  60  TO  4 
noTOMF  • nochan 

TYPSWT  « 1 

CALL  RODOTS(ARRAYJMEANSl) ♦STOOTStNSOOTSt 

• TYPSWT»DOTDMF.DOTOMC.ftOTDUM,COVAR* 

• NOCHAN, CHNVC»UTDM»C0VAR* 

• OOTnM,OOTOH,r)OTOM,DOTDM,OOTOM,DOTOH,KVAR) 
LNCAT  r NSDOTS 

00  500  I « ItNSnOTS 
DO  500  K s 1, NOFEAT 
III  * <I-1)*N0FEAT  ♦ K 
II  » III  ♦ MEANSl  - I 
‘lY(II) 


8: 

C* 


AWRAYdl)  » KVARdin 
IF  (NOCHAN. EQ.NOFEAT)  60  TO  8 
WRITE(6«110) 

no  format (IH  ,«N0  channels  for  STARTING  NOT  EQUAL  THAT  FOR  CLUSTER* > 
60  TO  9 
4 CONTINUE 

1F{1S0KEY.EQ.1)60  TO  7 

SURVEC-SUBCLASSFS  FROM  STATISTICS  FILE  FOR  INTIAL  MEANS. 
N0SU8^-NUMBER  OF  INITIAL  MEANS. 

CHNVEC-NUMBER  of  CHANNELS  FROM  STATISTICS  FILE.  NOCHAN  MUST 
IF(INITM,E0.1)60  TO  6 
LNCATal 
60  T0_8 

'*  CALL*6ETSt'(INUNIT,INFILE,ARRAY(MEANS1>  f0UM,N0SUB2*SUBVECf NOCHAN 

* ,CHNVC,ARRAY(TTOP) fCOVARtO) 

LNCAT  = N0SU92 

60  TO  8 
r CONTINUE 

IF ( ISOKEY. EQ. 1 ) CALL  RDFILE ( ARRAY (MEANSl », ARRAY (TTOP) » 
i CONTINUE 

IF(NOPTS.GT.O»GOTO  10 
WRITE(6,100)MAXOIM 

100  FORMAT (•  DIMENSION  LIMITS  EXCEEDED  IN  ISOCLS  BY»»I6. 

* • REDUCE  CHANNELS  OR  MAX .CLUSTERS* ) 

> CALL  CMERR 

10  CONTINUE 

IROsTOTPTS/NOPTS 

1F(M00(T0TPTS, NOPTS) .EQ. 0)60  TO  20 
KPTS=MOD(TOTPTS, NOPTS) 

IRD=IRD*1 

IF ( IRO.EO. 1 ) NOPTSsKPTS 
GO  TO  25 
20  KPTSsNOPTS 
25  CONTINUE 


C* 

a: 


a: 

c* 


c* 

C» 

c* 


c* 

c* 

c» 


CALL  ISOOAT  TO  PERFORM  CLUSTERING 
Alsl 

A2=A1*  MAXCLS*NOFEAT 
CL01=A2  ♦ MAXCLS*NOFEAT 
KPLCE  = N0PTS*N0FEAT  ♦ IDATl 

CALL  ISOPAT ( IDATl .ARRAY (KPLCE) .ARRAY (MEANSl ) .ARRAY (Nl) » 

* ARRAY(STDEVI) .KVAR  (CLOl ) .ARRAY (FOl ) ,KVAR (A1 ) . 

• KVAK(A2)) 

CHAIN  CLUSTERS  WHOSE  DISTANCES  ARE  LESS  THAN  DLMIN 


LNCAT=LNCAT*D0DU 

IF(ICHN.GT.0)CALL 


CHAIN(KVAR(CL01)  ) 


PRINT  FINAL  RESULTS 

CALL  PRINT (-I.AHRAY(KPLCE) , ARRAY (MEANSl ) .ARRAY (STOEVl ) » 
* KVAR  (CL01).ARRAY(FD1).ARRAY(N1)) 

CREATE  map  output  TAPE  FOR  PMIS  DAS  IF  DESIRED 


IF (MAPFMT.GT .0) CALI.  D5TAPE ( ARRAY (KPLCE) .KVAR ( 1 ) .ARRAY (MEANSl ) . 
► ARRAYIFOD) 


TES01790 
TES01800 

tNoibio 

TES01820 
TES01830 
TES0l84f 
TES0185( 
TESOl  ' 
TESO 
TESOi 
TES01890 
TES01900 
TES01910 
TES01920 
TES01930 
TES01940 
TES019S6 
TES01960 
TES01970 
TES01980 
TFS01990 
TES02000 
TCS02010 
TES02020 
TES02030 
EOUALTES02040 
TES02050 
TES02060 
TES02070 
T^02080 
TES02090 
TES02100 
TES02110 
TES02125 
TES02130 
TES021A0 
TES02150 
TES02160 
TES02170 
TES02180 
TES02190 
TES02200 
TES02210 
TE502220 
TES02230 
TES02240 
TES02250 
TES02260 
TES02270 
TES02280 
TES02290 
TES02300 
TES02310 
tN02320 
TES02330 
TES02340 
TES02350 
TES02360 
TES02370 
TES02380 
TE502390 
TES02400 
TES02A10 
TES02A20 
TES02-,30 
TES02440 
TES02450 
TFS02460 
TES02470 
TESO240O 
TES02490 
TES02500 
TES02510 
TES02520 
TFS02530 
TES02540 


FILE  TESTSP 


8: 

C« 


c 

c 

c 


c* 


LNCAT«LNCAT-OOOM 

CALCULATE  COVARIANCE  MATRIX  FOR  EACH  CLUSTER 

IF<VARSIZ»LNCAT.6T.KVARnM)G0  TO  30 
CALL  COVPAT(KVAR*IOAT1.ARRAY(KPLCE>  * ARRAY (MEANSI > » 
» ARRAY(Nl) «IBA0) 

CHECK  FOR  A CLUSTER  DELETED  FOR  SINGULAR  MATRIX 

IF(IBAD.NE.i)>STOP>0 
iF(IBAO.NE.O)60  TO  25 


26 


C* 

C* 

C» 


t lUIVKI  • 

>1*I)«IPT  ♦ 
>U2)aLNCAT 
)1«3)>N0FL0 


ARRAY(Nl*II-n 

LNCAT 

NOFLD 

NVRT 

FOI 


C* 

C* 

C* 

C* 


C* 

C« 

C* 

C* 


C 

C 

C 


8 

C 


no 

NN(T0TSUB*I1) 

TOTSUB  a TOTSUB 
NOCLS  * NOCLS  ♦ 

TOTFLO  » TOTFLO 
TOTVRT  » TOTVRT 
ARRAYCFO] 

ARRAY (FO 
ARRAY (FOl 

WRITE  STATS  FOR  THESE  CLUSTERS  ON  SCRATCH  FILE  18 

IF(NOCLS.EQ.l)  AORESaBEGINS 
IN=NOFEAT*LNCAT 

CALL  RwRITe(ADRES*ARRAY(MEANSl) «IN*JSTAT) 
AORESsAOHES*IN 
IN*VA«SIZ*LNCAT 

CALL  RWRITt(AORES.KVAR,IN,LSTAT» 

AD»ESsADRES*IN 
WAIT  FOR  I/O  COMPLETION 
60  IF(LSTAT,EQ.1»  ‘ ‘ 


GO  fO  60 


GO  READ  IN  ANOTHER  CLASS 

C0RBAS=C0RRAS*1PT 
IFILAST.NE.DGO  TO  5 
IF(N0CLS.LT.NCLASS»G0  TO  1 

NOW  READ  SCRATCH  FILE  AND  STORE  ON  SAVTAP  FILE  AND  PUNCH  ON 
CARDS  IF  REQUESTED. 


FLDl  » 
VERTXl 
CLSNMl 
NOSURl 
SURNMl 


FLOl  ♦ TOTFLO*A 
VERTXl  ♦ T0TVRT»2 
CLSNMl  ♦ NOCLS 
NOSUB 1 ♦ NOCLS 


RETRIEVE  INFORMATION  FROW  ‘ARRAY* 

CALL  GETINF (ARRAY (1) .KVAR(FLDl) .K VAR (VERTXl > .KVAR (CLSNMl) ♦ 
• KVAR(NOSUBl) *KVAR(SUBNM1) .NOCLS.TOTSUB) 

SWTCH  B I 

OUTPUT  stats 


_ LA9MAN(SAVTaP,STAF 1L. NOCLS. TOTSUB. nofeat. TOTFLD. TOTVRT. 
FETvEC.KVAR(FL01 ) .KVAR(VERTXl) .KVAR (CLSNMi ) .KVAR (NCGUDl ♦ ♦ 


30 

200 


CALL 

* F^ , . . 

* KVARCSUBNMl) . NN. BEOIN3. V ARSIZ. PUNCH. DUMMY ,§TATKY. SWTCH) 
RETURN 

KVsKVARDM 
WRITE (6.200)KV 
CALL  CMEHR 


FORMAT!* 
RETURN 
END 


DIMENSION  LIMIT  OF*«16«*  FOR  COVARIANCES  EXCEEDED*) 


TES02S50 
TCS02560 
TESofSTO 

If 


•S(_ 

■so: 
so: 
iso* 

TES026Ad 
TES0265Q 
TES02660 
TES0|670 
TESO.  ‘ 
TESO: 
TESO* 
TESO: 
TESO* 
TESO: 


{600 

*690 

>700 

*710 


TES02760 

TES02770 

TES02780 

TES02790 

TES02H00 

TES02810 

TESO202O 

TES02B30 

TES026A0 

TES02B50 

TES02B60 

TES02870 

TES02880 

TES02B90 

TES02900 

TES02910 

TES02920 

TES02930 

TES029A0 

TES02950 

TES02960 

TES02970 

TES02980 

TES02990 

TES03000 

TES03010 

TES03020 

TES03030 

TES03040 

TES03050 

TES03060 

TES03070 

TES03080 

TES03090 

TES03100 

TES03110 

TES03120 

TES03130 

TES031A0 

TES03150 

TES03160 

TES03170 

TES03180 

TES03190 

TES03200 

TES03210 

TES03220 

TES03230 


2 


FILE  COVPAT 


SUBROUTINE  COVPAT (COVARt ID«T1 t IPLACE«MCANS*N» IBAD) 


SUBROUTINE  COVPAT (COVARt 
IMPLICIT  INTEGER  (A-X) 
COMMON  ARRAY (10600) 


LOGICAL*!  LARRAY(A2A00) 
EQUIVALENCE  ( ARRAYtLARRAY) 
LOGICAL*!  LPACK(A) 
EQUIVALENCE  (LPACK* IPACK) 


IaCH^CLUS^ER^'^*^'*  CALCULATES  AND  PRINTS  THE  COVARIANCE  MATRIX  FOR 

INCLUDE  COMRKStLlST 
INCLUDE  C0MRK6»LIsT 


INCLUDE  COMRKStLlST 
INCLUDE  C0MRK6»LIsT 

COMMON/PASS/STOPtLNCATtNMIN»KRN.STDMAX.OLMlN*SEP# 

* MAPfSPTRIG.  IROt  KPfSt  NOPTSt  PUNCH* 

* ICHN,CHNTHS»ICHAIN<62) .NWDS.I0E6IN.BE6IN1, 

* RF6IN?*8EGIN3*ClSNAM.N0FLD»IPT»T0TRR0*T0TPTS# 

* NCLASS.N0CLS.T0TSU8.T0TFLD.T0TVRT.N0CL»NWRT 

* ,NXTCLS*N0FEAT.MAXCLS.FFTVEC(30I *SYMMTX(62) 


*.VARSIZtSTATKY. ISOKEY. MAPFMT*MaPKEY.SEQUEN(20) .PERCEN.SIMERP 
♦.lOPOER.INUNIT. INFILE. INITM.PMIN.SUBVEC (62) *N0SUB2»CHNVC (30) 
* .NOCHAN.ERCOMP.NOSEO.MEANOO.MEANOU* 


» SYMOO.SYMOU.ITRIGO.ITRI6U.DOFLA6* 

* DUFLAG*OaDU.STUOTS(60) .NSOOTS.SUNCOR ( 30) .LLNCAT. 

» DVERT(2S0,2) .OR£CT(60»2) .DVPNT ( 1 1 *2) . IDCNT (2) *N00U(2) 

► .MXFtTl .MAXPOP 
REAL  SUNCOR 

C0MM0N/6L08AL/HEAD(63) ,MAPTAP,DATaPE.SAVTAP.BMFILEiBMKEY. 

► HISFIL.HISKFY.TRFORM.ERIPTP.ERPKEY.MAPUNT.NOFILE* 

* DRUMAO.DPMWDS.PAGSIZ.DATFIL.STAFIL.ASAV.ASAVFL 

* .nhstun,nhstfi,sctrun,mapfil 

* ,OOTUNT,DOTFIL.NCHPAS»TRNSFL»BMTRFL.HISTFL*PCHUNT» 

* CRDUNT,PRTUNT*RAN0I0 

REAL  means. COVAP*TOL*DUMM(60) *DET 
DIMFNSICN  COVAR(VAPSIZ.'-NCAT)  * IPLACE  (NOPTS) 
dimension  MEANS(NOFEAT.MAXCLS) .N(MAXCLS) 

DATA  CH/*CH(»/ 

DO  10  I=1,LNCAT 
DO  10  J»1*VARSIZ 
COVAR(J*I)sO.O 

REAL  OUM 

IB  a (lOAT!  - 1)*A 
IPACK  s 0 
IBAD=0 

TOL=. 000000001 
ADRFSUREGINl 
ADRES2=  BEGIN2 


ICCT=NOPTS 
IRCsIRD 

IF(IRC.LE.l) ICCTsKPTS 
IF  (IHO.FO.O)  GO  TO  30 
lWROS=ICCT*NOFFAT 
fwOA  = IwROS/A 

IF  (A*IRtiA.NE.IWRDS)  IWDA  = IWOA  ♦ I 
CALL  RREAD ( AOPES! .ARRAY ( IDATl ) . IWDA. ISTAT) 
AOPFS1=aDRES1 ♦IWOA 
IF  ( ISTaT.EU. 1 )GO  TO  22 
CALL  RREAD  (ADWFS?, IPLACE. ICCT.ISTAT) 

ADRES2=A0HES2»ICCT 
IFnSTAT.EQ.DGO  TO  25 

SINCE  THE  covariance  MATRIX  IS  SYMMETRICAL  ONLY  THE  LOWER 
TRIANGULAR  PORTION  OF  THE  MATRIX  IS  CALCULATED. 


DO  45  I = l.ICCT  ^ _ 

IBASE  s IB  ♦ (I  - D*N0FEAT 

KK  = 0 

ICLS=IPLACE(I) 

IF(ICLS.GT.LNCAT)  GO  TO  45 
no  40  j=i.nofeat 

no  40  K=1.J 

LPACK(4)  a LARRAYdBASE 
IPACK!  a IPACK 
LPACK(4)  a LARRAYdBASE 


FILE  COVPAT 


IPACKl  ■ IPACKI*1PACK 
PUH  > IPACKl 


AS 


AO 


so 


51 

C 

C 

c 

52 


S3 
50 
160 
C 


55 


60 

70 

00 

90 

100 

110 

120 

lAO 

150 


iKK»l 

:OyAP(KK«ICLS)i 


PC- 1 

(tPC.GT.O) 

iFlNuIrlS^ofoi^ 


>COVAP(KKtICLS)«OUM 

60  TO  20 
TO  SO 


J«1»M0FEAT 

K«ltJ 


• HEAN$(Ktl)*HCANStJ*n 


KK«9 
00  50 
00  SO 

COV AR ( KK • I ) «COV AP ( KK 1 1 1 /N ( I ) 

CONTINUF 
IACEPTsPMIN^NOFEAT 
IFdACEPT.LT.NOFEATlGO  TO  58 

CHECK  FOR  SINGULAR  COVARIANCE  MATRIX 

DO  51  1»1.LNCAT 

CALL  CHLOET<COVAR(l,l),NOFEATfOUMMtOET) 
lF(DeT.LT,TOL»fiO  TO  52 
CONTINUE 
GO  TO  58 

DELETE  SINGULAR  COVARIANCE  CLUSTER 

WRITE(6tl60)I 
IF(LNCAT.E0.1)CALL  CHERR 
IRADsl 

LNCAT»LNCAT-1 
LLNCATaLLNCAT-l 
DO  S3  lUI.LNCAT 
DO  S3  11 I«l. NOFEAT 
MEANS (ill. ID «MEANS( III tll«ll 
CONTINUE 
RETURN 

format (2<.tCLUSTER». 15. • DELETED  FOR  SINGULARITY*) 
IF ( ST ATKY.NE.l) RETURN 
WRITE  (6. HEAD) 

WRITE(6.150)CLSNAM 
00  flO  Isl.LNCAT 
WRITE  (6.90)1 
no  70  L0C«1. NOFEAT. 12 
IST0P=L0C*11 

IFdSTOR.GT.NOFEAT)  ISTOPsNOFEAT 
WRITE (6. lAO) (CH.FETVEC ( J) . J*LOC. ISTOP) 

II»1 

KINCsl 

no  60  JsLOC. NOFEAT 

K»J*(J.l)/2-lI*l 

JK=K.KINC-l 

WRITF(6.100) (COVAR(M.I) .HsK.JK) 

11*11*1 

IF (KING. LT.ISTOP.AND.KINC.lt. 12) KINC«K1NC*1 
WRITE  (6.110) 

CONTINUE 

CONTINUE 

RETURN 

FORMAT(//'  COVARIANCE  MATRIX  FOR  CLUSTER* . lA/) 
F0RHAT(/6X.12F9.2) 

F0RMAT(///) 

FORMAT  (IHD 

FORMAT (9X.1?(A3.I2.*) *.3X) ) 

format (/•  COVARIANCES  FOR  CLASS* .2X.AA//) 

END 


COV00770 
COV00780 
COV0979P 
COVO  ‘ 
COVO 
COVO--._ 
COV0583 
COV008A 
COVOO0S 
COV0086 
COV0087 
COV0088 
COV0089 
COV0090 
COV009 
COV009 
COV009, 
COV009A. 
COV00950 
COV00960 
COV0097* 
COV0098 
COV0099. 
COVOIOOO 

covoioio 

COV01020 

COV01030 

COVOIOAO 

covoioso 

COV01060 
COV01070 
COVO1O0O 
COV01090 
COVOll 

covor 
covoi 
covoi 

COVO 
COVO 
COVO 
COVO 
COVO 

COVO 

COV01200 

C0V01210 

COV01220 

COV01230 

COVOi|AO 

covoilso 

COV01260 
COV01270 
COVO 1200 
COV01290 
COV01300 

mm 

COV01330 

COVOpAO 

COV01350 

COVOi36Q 

COV0l370 

COV013B0 

COV01390 

COVOIAOO 

COVOIAIO 

COV0Ia20 

COV01A30 

rDW0l440 


FILES  ISOPAT 


subroutine  lSOPAT(lDAntIPLACEfMEANS«NfSTDEV*CLO*FLDINF*AVPtAHN> 
IMPLICIT  INTEGER  (A-2) 


*LIST 


CSF.NO 


IMPLICIT  INTEGER 
INCUIOE  CQMMKS»L.,. 

INCLUDE  C0HBK6*LTST 

INCLUOF  CMRK16.LIST 

COMMON/PASS/STOP. LNCAt.NMINfKRN.STOMAX.DLMlNtSEP* 

MAP.SPTRIGt  IRO*  KPTS*  NOPTS*  PUNCH* 
ICHN«CHNTHStICHAlN<62) «NWOS* IBEGlNtBEGINl « 

BEGIN?. HEGIN3.CLSNAM,NQFLU*iPT.TQTW«O.TOTPTS* 
NCLASS.NOCLS»TOTSUH,TOTFLD.fOTVRT.NOCL*NVRT 
.NXTCLS. NOFEAT. MAXCLS*EETVEC( 30) .SYMMTX(62) 
*YARSI?.STATKY.I5QKEY.maPFMT.MAPKEY.SEOIIEN(?01.PERCFN.SIMERP 
.lORhEP.lKINlT.lNFlLE.lNITM.PMlN.SUBVECIG?) .n6sU02«CHNVC (30) 
.NOCHAN.ERCnMP.NOSEQ.MEANDO.MEANOU. 

S YMDO . S YmOU . I IR I go . 1 TRIGU ♦ OOFL  AG . 

OUF  lag. noOU . STOOTS ( 60 ) . NSOOTS . SUNCOR ( 30 ) .LLNCAT. 

DVFPT(2S0,?) .OPECT(60.2) .OVPNT (1 I .2) . IDCNT (2) .ND6u(2» 
.MXFETl.NAXPOP 
REAL  S'lNCOR 

C0MM0N/Gl0BAL/HEAD(63) .maptap.oatape.savtap.bmfile.bmkey. 

HlsFIL.HlSKEY.TRFOPM.ERIPTP.ERPKEY.MAPUNTtNOFILE* 

DPlIMAn.nRMwOS.PAGSI/.OATFlL.STAElLtASAV.ASAVFL 

.NHSTIIN.NHSTEI.SCTRUN.HAPFIL 

.dotunt.ootfil*nchpas.trnsfl.bmtrfl*histfl.pchunt» 

CRDUNT.PHTUNT.PANOIQ 

COMMON/ 1 SOLNK/SUN ANG ( 3 ) . I SUNT . I SUNC . SMSTR . SHSTP . SM I NC  * L INSKP 


EOUIVALFNCE  (FGMIN.STOMAX) 
peal  means. STDEV.STDMAX.SFP.AVP.  amn*sgha.rno* 

• TEST.DMIN.0LHIN.Cl  0. TIME.PERCEN.OIJ 
real  ESUM.ESOT.MEAN(30.62)  .sou 
logical  del 

dimension  AVP(NOFEAT.MAXCLS) .ISGMA(62> 

DIMENSION  AMN(NOFEAT.MAXCLS) .SbMA(62) 
dimension  IPlACE (NOPTS) 

DIMENSION  MEANS(NOFEAT.MAXCLS) .N(MAXCLS) 
DIMENSION  STOEVINOFEAT.MAXCLS) .CLO(MAXCLS.HAXCLS) 
dimension  FLDINF(l) 

REAL  SDDM 
DIMENSION  PTR(6?) 

DATA  SS/»St/.CC/»C*/ 

EOUIVALENCE  (KOIM. NOFEAT) . (LNCAT. INCAT) 

0EL=. false. 

ISEQbO 

MAXCL  * maxCLS  - ooou 

IDUMsLNCAT.nooU-MAXCLS 
F(IDUM.GT.O)  LNCAT=LNCAT-IOUM 
STOP»STOP 
SPLF|N«0 
KKT*I 

DO  5 I * 1.30 
SUNCOR(I)  * 1. 

“ '.NE.0.( 


C* 


IF  (ISUNC.NE.O.OR.ISyNT.NE.O) 
► FETVEC.NOFEAT.lSUNC.lSUNt) 

LK«K 

ASSIGN  DATA  TO  CLUSTERS 


CALL  SUNFAC(SUNC0R*SUNANG« 


10  CONTINUE 

NCAT  r LNCAT 


* OOOU 


u 

1.^ 


y^^(DOFLAG.FO.O)  GO  TO 
T.NOFF) 


12 


DO  11  Jal.NOFFAT 
MRANS (J.LNCAT*! ) sMEANDO 
IF (DUFLAG.EO.O)  60  TO  lA 
on  13  J=l. NOFEAT 
MEANS (J.U.NCAT)  » MEANDU 

continue 

00  15  *f  = l. LLNCAT 
00  Is  J=l. NOFEAT 
IS  MEAN(J.K)  a MEANS(J.K) 

IE  (LNCat.LE.) .ANO.KKT.uT.l)  GO  TO  530 

call  P^RPAT (ME anS.STUEV.N.ClO. I0AT1.IPLACE.AVP.AMN. MEANS) 

'ALL  CLOCK(TIME) 

E (MOD  (kkT.KRN)  .EO.O)  write  (^>.  120)  KKT.  TIME 

OPMATC  fUMUl.ATIVE  time  AFTER  ASSIGNING  DATA  TO  CLUSTERS  FOR 
• AT10N*.I4,'  IS».U0,6) 


120 


SOOOOSC 

S00006C 

SOOOOTC 

im 

SOOO  0( 
SOOO  1C 

S§00  Sc 

SOOO  AO 
SOOO  “ 
SOOO 
SOOO 
SOOO 
I SOOO 


SOOOO] 

SOOOOf 


ITER 


S00023C 
S00( 

soooi 
soool 
soool 

SOOO. 
SOOOj 
SOOOi 
soooj 
sooo:  . 
S000350 
S000360 
S000370 
S000380 
S000390 
SOOOAOO 
S000410 
SO00A20 
SOOOA30 
S0004AO 
S000450 
S000460 
S000470 
S000480 
S000490 
S000500 

pS8li8 

SOOOS30 

S000540 

S00Q55Q 

SOOOS60 

SOOOS70 

SO00S80 

S000590 

S000600 

S0006I6 

S000620 

S000630 

S000640 

S000650 

S000660 

S000670 

S000680 

S000690 

S000700 

S000710 

S000720 

S000730 

5000740 

S000750 

S000760 

S000770 

S000780 

IS000790 


ISOPAT 


riL:  * 


.^RCOHP.NC.nOO  TO  135 
lUfiad.O 


132 

133 


' (STOEV  < J.Kn ••2/TOTPTS 


88  m 

ESUM«rSUM*N7K»*(Sl 

continue 


ii” 


•FT. 3/) 

CALCULATE  DISTANCES  BETWEEN  CLUSTER  CENTERS 
CALL  CL01ST(CLD.STDEV«MEANS> 

IF  STOP  EQUALS  ZERO  DELETE  SMALL  CLUSTERS 


PERCEN  ■ •♦F5.3*'  STOMAX  ■ ». 


LNCATiiL 

IF  IMOOCKKT.MAPi)^  1§0.140.|50, 


140  Call  PPINT(KKT 
GO  TC 


■♦lpLACEiMEAN§;STOEV.CLO»FLOXNF*N> 

ISO  IF  (MO^tKtrT.KRN) ) 16ltl60.161 

CALL^PpfNTIKKTtlPLACE*MEANSfSTDEV*CL0*FL01NF*N» 
161  CONTIHUE 

LNCaUlLNCAT-OOOU 
IF(;STOP.EO.O)60  TO  162 

FOR  ITERATION  N CHECK  N(K)  AGAINST  PMIN  ♦ NOFEAT 
NOSED)  GO  TO  169 


162 

163 


1?' 


^ ! ipMlN*I  NOFEAT))  167. 163*163 


. (NIK) 

CONTINUE  . 

IF  (.NOT.OFL)  RETURN 
00  KKal.LLNCAT 
00  164  KKK*l. NOFEAT 

00  165  K*'»l  »LLNCAT_ 

DO  16K  KKKal .NOFEAT 
165  MFANIKKK.K‘<)  ■ MEANS  (KKK.KK) 

CALL  CL0IST(CL0. STOEV. MEANS) 

RETURN 

l68  F0RHATt/*^CLUSTER'Il3i'»*REM0^  FOR  HAVING  ONLY' *16**  POINTS.'/ 
•'  MIN.  POINTS  IS  C.I4,'  ♦ '«I2*')') 


171 


169 

170 


190 


190 

195 

200 


201 

210 


PETF«l 
LK»K 
60  TO  570 
K»LK 

DEL  « .TRUE. 

GO  TO  162 
ONTINUE 
ONTlNUE 

Of/  ITERATIONS  I THRU  N-l  CHECK  N(K)  AGAINST  NMIN 

00  190  Kal. INCAT 
Tf  (N(K)>NM1N)  190.180*190 

nO^LVcALL  CLOISTICLO.STDEV.MEANS) 

Imo^?KKT»K9N) ) 200.195.200 
WRITE  <6.210)K.N(K) .NMIN 
PETF-2 
LK*K 

GO  TO  570 
KbLK 

DEL*. TRUE. 

GO  TO  ‘ 


176 


i 

C» 


ORMATCO  CLUSTER  '.12.' 
2 ' elements,  min. 

220  CONTINUE 


REMOVED  FOR 
NO.  ELEMENTS 


HAVING 
IS  '.16) 


ONLY  '*16* 


SPLIT  ITERATION 


23<f 


8t!8 

(19 


Qi  16951 

oollaK 


99( 

'99C 

9* 


0692 
SOO09L 
“0094i 

ijflll 


\iV 

18! 

8! 


# V . * V 

!8  m 

S!8 


SOO] 

SOO 
SOO 

sool 

S001540 
SOO I ISO 
SO01560 
S001570 
S001580 


HLEt  ISOPAT 


S 


225 


ir«o^ 


iNCAT 


Kal«lNCAT 

FIND  MAXIMUM  STANDARD  DEVIATION  PER  CLUSTER 

S6MA(K)  ■ 0. 
no  .250  ^^«^l.NOfEAT 


240 

250 

260 


503 

502 


UM 

(snuM 
SGMA<K> 
GMA(K»  i 
NUl 


» j 
SOUM 


- >'UL 


MA^K) .6E.ST0MAX) ISPLT«ISPLT*1 


F (KKT  ,6T.  ISTOM»  Si 
I JSPLFlN  .FO.  0)  GO 


}F  <SPL  . . _ 

F <MODCKt<T«KRN) 

ORMAT<  /) 

TF(MOn(KKTtKON) .eo.O) WRITE (6*50?) 
format (IX. 'USER  INPUT»SPLlT-C 

I^^^SEOufNtlsFoj.eo.sS)  GO  TO  270 
IF  (SEOUEN(ISEO) .EO.CC)  GO  TO  4l0 

IS  SPLITTING  REQUIRED 


_ TO  270 
.EQ.  0)  WRITC(6*503) 


USER  INPUT»SPLIT-C0M9INE  SEQUENCE  OF  ITERATIONS*) 


270  K«1 

NCAT«INCAT 

?A0  IF  (K-NCaT)  290.2R0.5QO 
290  IF  (STnMAX-SGMA(K) ) 300* 
TOO  IF  (N(K)-(NMIN*NMIN*?)) 


310  KbK*1 
GO  TO 


^lotJIE.320 


200 


SPLIT  CLUSTER  K 


320  TR1G1«1 
DEL».“ 


330 


340 


, TRUE, 

KX*ISGMA(K) 

INCAT*IMCAT*1 

GO  TO  350 
. )WPITE(6.340)KKT 

. 4.  ^ « CLUSTERS  ON  ITERATION* » I4/»  SPLITTING  REQUIRED 

•UT  NOT  PEPFORMtO.*/) 

LNCAT  « MAXCL 
LLNCATbMAICLS 


350 

3?^® 

300 


on  TO  500 

|nc«Tncat 

LL«PTR(K) 

DO  370  I»1.K0IM 
AMN(I.INr)«AMN(I*LL) 

4M -i(KX.Lt  )»AMN(KX.LL)  *SEP»SGMA(K) 
AMrjO>X*fNC)«AHN(KX.lNC)-SCP*SGHA(K) 
Sr.M4(w)  »0.0 

IF  (MOn(KKT.KRN) ) 400*401*400 
WRITF (4.390 )LL.KX. INC 
jMEr 


390  format (*0  CLUSTER  **I2**  IS  SPLIT  IN  THE  *»I2**TH  PARAMETER  INTO  C 


2LUSTFR  »*I2) 

400  CONTINUE 
K>K*I 
GO  TO  280 

15  EVEN  ITERATION 

\ ARE  CLUSTERS  TO  0E  COMBINED 

'410  CONTINUE 

no  405  LbI.LNCAT 
^405  PTR(L)»T 

nocomb»o 


Soo 

sot,,- 

18811 


SOO 

§oo 

soo 

soo 

soo 

p 

$00 

soo 

soo 

188 

soo 

soo 

soo 

sool 

sooi< 


S002000 
5gp2010 


. V > V 

;8i 


0 
soo 
soo 
soo 
soo 
soo 
soo 

500 

soo 

soo 

soo 

soo 


S002 

I88| 

188)2.0 

S002210 

I88ll!8 

S002240 

«0o?250 

SO02260 

S002270 

S»)02?80 

<5002290 

S002300 

$002310 

SO02320 

$002330 

SO02340 

S002350 

$002360 

S002370 


riLCl  ISOPAT 


406 


00  TO  450 


420 


425 

>30 


>60 


461 


I^NO^LST«LNC4T-l 

NfeiS'S’cSSSV’r 

KK*0 

DrHWIjNOCtT. 

|r<PT»m.co.oi6o  to  430 

1F(P?»»  j’!ii!^ofSJ  TO  42S 
SftlJ  ■ 0.0 
')Q  420  JJ«1*K0IM 

551 jfSOjj*  < UHN« JJ. I ) *AMN I JJt J) » ••2/ (STOEVI JJt I ) ♦STOEV  UJt Jt I ) 
CONTINUE 

olj«so(<r(soij) 

I^FjOIj^lOT.DMlNlOO  TO  425 
KKBl 

^SntInui 

*r(KK.EO,0)OO  TO  460 
>>TR(KKfan 

CONRINC  CLUSTERS  KK  «N0  KKK 
nELB.TRUF. 

RN0>1.0  /FLOAT  (N(KK)*N(KKKU 
DO  460  K«ItK0lM 

AMN(K.KK)>(N(KIO*AMN(K.KK}*N(KKK)*AMN(KiKKK)  1«RTR> 

RETF»3 
LKvKRK 
GO  TO  570 
KKK*L^ 

IF  (KKK.EO.(LNCAT*in  GO  TO  435 
MOVE  POINTERS  UP 


DO  175  KbKKK.LNCAT 
175  oTRJIO  ■ PTR(K*D 


44 

4»40 


TF(M0'>(KKT.KONn440«441«440 
V01TF(4,<.9P>kK.KKK«KK 
IF  (L.LT.NOCLST)  GO  TO  406 


4R0  continue 
490  format <• 

2ER  ‘flEI 


CLUSTERS  'tlEt*  AND  HAVE  BEEN  COMBINED  INTO  CLUST 


500 


REINITIALIZE 

)MAXCLS 


CONTINUE 
DO  510  J»1 


$GMA(J)>oiS 
!SGMACJ)«0 
DO  51fl  Kal.KOIM 
AyP(K. J)b0.0 
STOEV(K.J) bO.O 
MFANS(K.J)>AHN(K.J) 
AMN(K. Jlsn.O 
SIO  CONTINUE 
Ki'TbKKT*) 

OEL«. false. 

GO  TO  10 


IF.iFKT.NF.^j 


GO  TO  550 


530  . 

uPlTf 

540  FO«m*T(*  THF,  original  cluster 
•U'E  FOR  STQMAA*/> 

K«T»1 
I^TOPbO 
GO  TO  10 


MAS  NOT  SPLIT  - examine  ThE  INPUT  VA 


>00< 


94/4 

I8f‘ 


i8l 


003C 
SO03C  _ 
S00304( 

Soor 
soo; 


SO0307< 


S003I 

ISO 

5003 

I9j 

foo5 

5003 

?I 

5003 

5003 

3$ 

SO03 

40 

5003 

50 

5003140 

nut  ISOPAT 


f 


FILE  I PSPPAT 


P^PPAT (MCANStSTOEVtNtCLO* IDATl t IPLACEt AVP*AMN*MEN> 

U-r 


csend 


fMPL?Cll^fNTFGFP  U-p 
COMMON  (lOOftoT 

LOGICAL*!  LARPAV(A?4O0) 

EOUIVAI.ENCF  <LAPRAY(1)  ♦ARPAY(l)  » 

LOGICAL*!  LPACK(4> 
oiMFNsroN  iPACKm 

EOUIVALENCF  (tPACK(l) tLPACKIl) ) 

INCLUDE  COMPKS.LIST 
INCLUDE  CMPKlf»»Ll|T  ^ 

C0MM0N/PASS/ST0P*LNCAT*NM1N.KMN«ST0HAX.DLMIN»SEP* 

* MAP.FPTPlGt  IRD.  KPTS.  NOPTSt  PUNCH* 

* ICHN*CHNTHS*ICHA1-  »N«DS* IREGIN.BEGiNl , 

* begin; -e  gin3.clsnam*noflo.ipt*totwro*totpts* 

* NCLASS.  )CLS.TOTSUB,TOTFLD.TOTVRTtNOCL*NVRT 

* .NXTCLS«NOFFAT*MAXClS*EF. 'VFCOO)  «SYMMT*  (62) 

*«VARSI2*STATKy. ISOKEY tMAPFMT.MAPKEY*SE(JUEN (20) »PERCEN»SIMERP 
*.  lORDEPtiNUNiTt INFILE  1 INI TM*PMIN,SUBVEC( 62) »N0SUB2.CHNVC (30) 

* • NOCH A N • F RCOMP • NOSEO  « MF  ANOO  * ME  ANOU  » 

* SYMDO.SYMOU.ITPIGO. ITMlGUtOOFLAG* 

* DUFI  AG.noOU.STnOTS(60) »NSOOTS.SUNCOR(30> *llncat* 

* OVERT(?So,2) .ORECT(60*2) *0VPNT ( 1 1 .2) . 10CNTT2) *N00U(2) 

* *MXFET1 .MAXPOP 

C0MM0N/IS0LNK/SUNANG(8) ♦ISUNT»ISUNC»SMSTR.SMSTP»SMINC*LINSKP 


5 

C* 

C* 

C* 


20 


25 


30 

40 


41 


IPLACE(NOPTS) »AMN(NOFEAT*MAXCLS)  ^ 
STOEVSNOFEAT.MAXCLS) .CLO (MAXCLS»MAXCLS) *N(MAXCLS) 


;OIST*RND«MEANS 


N (LNCAT* 1 ) =ND0U (DOFLAG) 

N ( LNC  AT ♦ DOOU ) =NDOU ( OOCU ) 


niMENSION 

DIMENSION  . __ 

DIMENSION  AVP(N0FEAT*MAXCLS) *MEANS (N0FEAT»MAXCLS) 
PEAL  mEN(NOFEAT*MAXCLS1 
REAL  AMN.STDEV.AyP*SOISt? 

DIMENSION  CSUN(30) 

REAL  CSUN 
real  0UM«0UMA 
IB  a (lOATl  - 1)*4 
IPACK(l)  a 0 
DUM  a .OOOOl 

IF(DOFLAG.NE.O) 

IF(DUFLAG.NE.O) 

DO  5 lal, LNCAT 
N{ I) =0 

DO  5 Jal. NOFEAT 
AMN(J.I)rO.O 
STDEV(J»I)  a 0,0 
AVP( J*I)=0.0 

ASSIGN  DATA  TO  CLUSTERS 

ADRESIaBFGiNI 
ADRFS5*=8FGIN2 
ICCTaNOPTS 
IRC=IRD 

IF(IRC,IE.1)ICCT=KPTS 
IF(IRP.EO.O)GO  TO  40 
IWROS=NOFEAT*ICCT 
1WD4  a imRDS/4 

IF  (a*WD4.NE.ImROS)  IWD4  a lwD4  ♦ 1 
CA(  L RPFAD(ADRFSl*A»RjiY(IDATl)  »IW04*ISTAT) 
A0RES1=ADRF.S1»IWD4 

' 25 

40 
40 


TO 


IFdSTAT.EO.DGO 
IF(IST4T.EO.n)G0 
IFdSTAT.GE.fUGO 

WRITE (6.30) ISTAT  . , 

FOPMATd  ERROR  HEADING  DRUM ISTAT='.I4) 

CONTINUE 

IF  (IS'INT.EQ.O.ANO.ISUNC. 

DO  49  lal.ICCT 

IBASF  a (I  - 1)*N0FEAT  ♦ 
iF(Donu.Eo.n)  60  to  42 
DO  41  Kal .NOFEAT 

LPACK(4)  a LARRAYdBASE 
COl'M  a IP^Ck  ( 1 ) 

IF  (COUm.NE.MEANOO.ANO.COUM.NE.MEANOU) 
CONTINUE 

IF  (CD'tM.FO.MFANOO)  IPLACEd)  = LNCAT 
IF  (CDMM.FD.E'tANOU)  IPLACE(I)  = LNCAT 
GO  TO  49 


:q.o)  go  to  50 
► IB 


♦ K) 


GO  to  42 
1 

DOOU 


p;poooio 

p -.POOOZO 
P'.B00030 
PGP00040 
PSP00050 
PSP00060 
PSP00070 
P5P00080 
PSPOOORO 
PSPOO  ‘ 
PSOOO 
PSPOO 
PSPOO 
PSPOO 
PSPOO 
PSPOO 
PSPOO 
PSPOO,, 
PSPOOI90 
PSPOOfOO 
PSROOliO 
PSP00220 
P5P00230 
PSP00240 
PSPOC2SO 
PSP00260 
PSR00270 
PSP00280 
PSD00290 
PSP00300 
PSP00310 
PSP00320 
PSP00330 
PSP00340 
PSP00350 
PSP00360 
PSO003t0 
PSO00380 
PS»00390 
PSO00400 
PSP004I0 
PSP00420 
PSP00430 
PSP00440 
PSP00450 
PSP00460 
PSP00470 
PSP00480 
PSP00490 
PSP00500 
PSP00510 
PSP00520 
PSO00530 
PSP00S40 
PSP00550 
PSP00560 
PSP00570 
PSP00580 
PSP00590 
PSP00600 
PSOOO6IO 
PSP00620 
P5P00630 
PSP00640 
PSO00650 
PSD00660 
PSP00670 
PSROO60O 
PSP00690 
PSP00700 
PSP00710 
PSP00720 
PSP00730 
PSe00740 
PSP00750 
PSP00760 
P9P00770 
PSP007B0 
PSP00790 


FILE!  PSPPAT 


45*46«<»6 


ItlCCT 

(1  - l)*NOFEAT 


KK>1 

SOIST«10.0E*20 

BO  A6  J«1*LNCAT 
IST>0« 

00  44  K»l. NOFEAT  

LPaCK  (4)  ■ LARPAYdBASE  ♦ K) 

0 1 ST«B I ST ♦ ABS  < MEANS  <K i J ) -CSUN (K ) ) *SUNC0R (K ) 
IF  (OIST  • SDIST)  45.46.46 
KKaJ 

SOIST*OIST 
CONTI NUE 
CONTINUE 

N(KK)=N(KK)*1  . 

IPLACE<I)=KK 

00  48  NOFEAT 
AMN(K.KK)sAMN(K.KK)*CSUN(K)  ^ 

AVP<K.KK) »AVP(K.KK» ♦CSUN(K)**2 
CONTINUE 
CONTINUE 

CO  TO  101  . 

DO  100  I s I.ICCT 

IBASE  * (1  - l)*NOFEAT  ♦ IB 
KK*  1 

IF(DODU.EO.O)  GO  TO  52 
00  5i  KsI.NOFEAT 

LPACK(4)  = LARPAYdBASE  ♦ K) 

CDUM  a IPACKd) 

IF  (CDUM.NE.MEANDO.AND.CDUM.NE.MEANOU) 
CONTINUE  « . 

IF  (CDUM.EO.MFANOO)  IPLACE(I)  * LNCAT 
IF  (CDUM.EO.MEANOU)  IPLACEd)  = LNCAT 
GO  TO  100 
CONTINUE 
KK  * 1 

SOIST=10.0E*PO 
DO  70  J*l. LNCAT 
niST»0.0 

DO  55  K = 1. NOFEAT 

LPACK(4)  = LARPAYdBASE  ♦ K) 

CSUN(K)  = IPACK<1)  ^ 

DIST  = DIST  ♦ ABS(MEANS(K. J)  - CSUN(K) 
IF(OI5T-5DIST)60.70.70 
KK*J 

SDISTsDIST 
CONTINUE 
CONTINUE 
N(KK)=N(KK)»1 
1PLACE(I»=KK^^  , 

DO  90  K»l. NOFEAT 


TO  52 


TO  52 


IPLACEd) 

IPLACEd) 


LNCAT 

LNCAT 


- CSUN(K)) 


AMN(K.KK)  = AMN(K.KK)  ♦ CSUN(K) 

AVP(K.KK)  = AVP(K.KK)  ♦ CSUN(K)*»2 

continue 

CONTINUE 

CONTINUE  . 

IF(IP0,EP.O)C0  TO  110  ..... 

CALL  RfcPlTE (ADRES2.1PLACE.ICCT.1STAT) 
ADRES?=APRESP»ICCT 
IFtlSTAT.EO.DGO  TO  105 

lF(iPC^GT.O)GO  TO  20 
KA  = I 
CONTINUE 

no  13«  K=KA. LNCAT 
IF(N(K) ,EO.n)GO  TO  130 
RND=FLOAT(N(K) ) 

00  130  Jsl.NOFEAT 
AMN( J.K) sAMN ( J.K) /RNO 
MEANS (J.K)=AMU(J.K) 

5T0EV( J.K) =50RT (AVP( J.K) /RNO-AMN ( J.K) *AMN ( J.K) ) 
DUMA  = STOEV( J.K) 

IF  (OUMA.LT.DUM)  STDEV(J.K)  = DUM 


CSUN(K) 

CSUN(K)*»2 


CONTINUE 

RETURN 


CRiGit'iHL  PmGE  !: 
OF  POOR  QUALITY 


PSP0Q800 
PSP00810 
PSP00820 
PSP00830 
PSP00840 
PSP00850 
PSP00860 
PSP0OB7O 
PSP00880 
PSP00890 
PSO00900 
PSP00910 
P5P00920 
PSP00930 
PSP00940 
PSP00950 
PS®00960 
PSP00970 
PSP00980 
PSP00990 
PSPOlOOO 
PSPOlOlO 
PSP01020 
PSPO  030 
PSOO  040 
PSPO 1050 
PSP01060 
PSP0I07O 
PSPO 1080 
PSP01090 

pspoiioo 

PSPO  ,10 
PSPO  . 20 
PSPOl  30 
PSP0il4O 
PSPO  .150 
PSP01160 
PSP01170 
PSPOllBO 
PSP0il90 
PSP01200 
PSP01210 
PSP01220 
PSP0i|30 
PSP01240 
PSPO 1250 
PSP0i260 
P5P01270 
PSP0j280 
PSP01290 
PSP01300 
PSPOlSIO 
PSPO 1320 
PSP01330 
PSPO 1340 
PSPO 1 350 
PSP01360 
PSP01370 
PSP01380 
PSP01390 
PSP01400 
PSP01410 
PSP01420 
PSP01430 
PS=01440 
PSP01450 
PSPO 1460 
PSP01470 
PSP01480 
P5PQ1490 
PSPOISOO 
PSPOISIO 
P5P01520 
PSP01530 
P5P01540 


FILE*  «nap*T 


c* 

c« 

r* 


TMIS  SUrtPOtiTlMt 
FPOM  TMF  lM4f,F  ' 


C 

c 


. COO-^DlNATE*;  Tr>E  -^OOTlNfS  TO  PtAU  FIE'  !TS  OF  DATA 
TftPE  AUn  STOOE  IT  ON  A DftU-4  FILE  FO» 

THE  ISOCLC  rtO'iTlNtS. 

SUHPOUTTnF  »')0PAT  (FOl  .TOP,  lOiTA,  IQIm.LAST) 

IPPLICTT  TnTFOFO  (4-7) 

OIhEHSION  FLHINF  (A)  , IOATA  nOIM)  ,fL(12»  .LSI  AT<3) 

CO'»‘'Ot..  4P34rnOf»O0) 

LOOIC«L*l  LAPi-flY  (‘♦2^00) 

FOillvr'LFMCF  ( iPPAY.LAPPAY)  . . , 

I.OPTCaL*!  LPACK(a) 

FOMIVAL'^'nCF  (LPACK.IPACK) 
iNCl.tlOF  Coi-tf-S.I  1ST 
INCLMOF  CO-.*-«S,lIST 

COMN'ON/PASS/STOP.LNCAT  .MMlN.KkVA|,ST  Ji'«AX.OL'^iN.S£P» 

* „.4f-.tPTPT0,  IKO.  KPTS.  UOPTS.  PUNCH, 

* IChP.CHmT'^'^.  ICnal'i  (r.21  ,k  m)S.  I“>r‘‘ilN,-«EGlNl . 

* PFr,I  j?,.itGl!'3,CLS'.4'^.U0FL0,  IPT.TOTwRQ.TOTPTS, 

''’Cl  ■'SS«'-'OClS,T('T'^U-  .TOTFlIJ.  To  fVKT.NOCL.NVHT 

* .NXTCI  S.hOFfftT.'sa>^CL*-.FF“ “ 

«.VAwST?. --  - - 

*.  lO-JOF®.  IMI  ilT.  TiK  IL--:  . I'vl 

* . nOC HftM  . FHf;0‘ Ip  . WiS? 0 . -if  ANOO . •JE  ANOU . 

* SY«'*nO.‘^Y*':ih.  ITPIGO.  ITPIO.i.oOFLAO. 

* OUKI  AO.I’ODU.STOfiTSd^O)  . NSnoTS . SUNCOK  ( 30 ) .LLfJCAT. 

* nvFOT  (?SA,7)  .ilPECT  (SO.?)  .nyPf-T  ( 1 1 .2)  .IDCnT  (2),M00U(2) 

« ,m*FFT1 .MIXPOO 

hfal  SiinCpk 

COMPON/OLnHAL/HEAQ  (63)  .mapT  AP.  iaT  apF.SAvTaP.^mFILF.HH'^EY. 

^ ___  . _ 

* 

» 


’''U  'S'..  ''’IJl  LN.  11'  I '-ll-  . T W I f LO.  MU  VK  I .NUGL.NVK  I 

S.(iOFF4T.'saxCL*-.FFT'>rC(  33)  ,STM  axj62) 

'.STaTky,  TS  'kF  Y.  aaPFMT  .mAPkfy,sE:j|>iEN(?0)  .PEPCFN.SIMERP 
f.  IMI  ilT.  l iF  IL--;  . I'vIT  -SP  •]  J.tUSvEC  (62)  ,nOSU>j2.CHNVC(30) 


CfENO 


“•isFlL.HlS.^f  Y.TpF0KM,EpIPTP.E-V6EY.'-1A»'JnT.N0F;lE. 
DPI  IP  an,  •ns.pAiiSl  / .najF  IL.STaF  IL.  aSsv,  aSAVFL 
.nm^Tju.mhftf 1 .sCTkun.mapfIl 

.nnT'i'tT.Of’TFIL.iiCHPAS.TNNSFl.  .PHTHFL.MISTFL.PCHUNT. 
CPDUNT.PHTUmT.KANOIO 


PPII.'IT  = 30 
DT’-’FNSIHN  CAP0(?0) 

Fnul  valence  (FLOMF  ( 1 ) .lIN'^TK)  . (FlDINF  (*4)  .SAHSTH)  ♦ 

* (Fini'.F  (;?)  ,i_ji^.!-mO)  . (FL^I^F  (S)  .SamcnO)  . 

* (FLOl-'F  ( 3)  .LININ  G)  . (FLuImF  (6)  .SAHINC) 

DATA  L DON/' ( ' / 


OTPFnSIOn  Lr' 

0(2)  .LOnodi  ,2)  . 

* niNTUP^.P 

) .OPI  ,'T  (12.2)  .ni' 

DATA  nO;,'A‘E/ 

•OTHt'/ 

DATA  DO''Ai.-F/ 

• ii  mTD*  / 

UiMFtiSInN  FlDSAm(A.IO)  .vFpTE 

r* 

c* 

PFSFWVF  ?oon 

LOCATIOh'S  OF 'API 

C* 

THE  KF«AiNOF 

P OF  'APPAY*  IS  ' 

r*  . 

C* 

CLASS  and  FI 

Flo  infopmatiom 

C* 

r* 

C* 

APPAY { ) ) 

"CLASS  NApF 

r* 

ApF  AY  (■>) 

SPF'FFPWH)  F()P 

c* 

APPAY (3) 

"l^ESEPvtO  FOP  ! 

c* 

APP  AY  (^-) 

=M'(.  OF  FI  FI  os 

c* 

APPAY (t) 

=FIPST  FT  Fin  f| 

r* 

(‘  ) 

= "'0.  OF  VFPTTO 

c* 

(7)- 

(7.NV"-*)  = ACT) 

r* 

( 

VM'2)  "TOTAL  PlX 

c* 

(P.IJ 

V<i2)  - ( 1 '^♦NVPP)  = 

P J Y ' 
'JSEO 


FOP 

FOK 


FIPLQ  definition  INFOHHATION 
I/O  HuFfLhS. 


CALL  TS'^  POP  (OATADE  .OaIF  ID 
rONTUi'lr 
K^SF  pv  = 2A('a 
Anr)KFs=PFOiMi 
I..iiF  = l 
I. <‘•■’0  = 0 

NVPTsO 
L AST=0 
TnTWKOrO 
IiAp  r n 
DOFLAG  = 0 
OuFLAG  = n 
01^100  = 0 
fgrioo(l)  = 0 
KinniK?)  = n 
6riijDX=KE'?FKV+ 1 

nmufs=i 


STOpFO  as  FOLLOivS 


1 iDF*  FOINTES  To  next  CLASS  NAME 
NO.  OF  CLOSTEPS  IN  THIS  CLASS 
Fit-  TnlS  CL“S'' 

AmK  fop  THl^  CLASS 
P^  FOP  TrilS  FitLD  (NV) 

Al.  vFPTEx  NU;-lHtKS 
EL'^  I"  THIS  FltU) 

FLO  IMF  hluck  m)p  This  field 


HODOOOIO 

HDU00020 

HUi)U0U30 

HUDU0040 

H0000050 

HOU0CO60 

KU000070 

kUi)00080 

HD'3O0090 

HDUOnlOO 

Hooooiin 

kUl)00120 

K0000130 

WOf)O0lA0 

Houuoiso 

K0000160 

HOU00170 

HDunoiao 

HUUU0190 
POUOOlpO 
HQOUOlIO 
HOD00220 
H0000230 
Hi)uU02A0 
HODO0250 
H0000260 
wOl)00270 
KDDO0280 
PDU00290 
P0000300 
KODOOJiO 
Hl)0003|0 
H0000330 
KOt)003A0 
p'TOOOaSO 
HDl)00360 
KOUUO370 
hi)U00380 
KDD00390 
KODOO'.OO 
KD000410 
HDOU0A20 
K0000430 
pijL)004.An 
K0()o0<.50 
K0Oi)0A60 
HOOOOA70 
.POU00A80 
K0000490 
HDOoObOO 
HDuoosin 
k(jUOOS20 
p 000 0530 
pDUOnSAO 
K0000550 
pOOOOShO 
KOD00570 
K00005«0 
KDIJOOS90 
HOU00600 
HUJ00610 

Pl.i00062n 
KOOUO630 
pOOnOHAO 
PO000650 
pDDoOSGO 
PI1OU0670 
PIJOOO6K0 
PODU06V0 
PDOUO  700 
kOOO0710 
POO00720 
PO000730 
KD0007A0 
PiDOOn  7S0 
PUUUO760 
PDD00770 

koooo7ho 


HLfJ  HOOPAT 


MA<(>lMsTOr>-*^FSt.WV 

HuFSI/s  4/(\rj'tFS*NnFFM)  * '•jOFEAT 

miFST^  s (n,iF<;jV/'4)*4 

IF(-MF«;i7.'iT,  inn»(,0  TO  3 
h»F<iFPV=**ecF^V/-ino 
IF(P(;SFPV.GT.T0  )G0  to  ? 

GO  TO  7') 

7 COnTINDI- 

'-JOFI  fian 

IDT=1  ♦ FHl  - 1 
ToTVT?*(> 

IF(OOCI  .FO.rOGO  TO  5 

4 AOPAY(ThT)=N)<TCLS 

IPT=I0T*4 

(4,Mc^O) 

^3ITF  (f«.‘;no)N<TCLS 

r* 

C*  RFaO  a FIFlO  OE'iC^IPTlO'X  FROM  CAOOS. 

r* 

5 ITK  = I A(}FAO(AROAY  (IPT)  . AR^AY  ( IPT^i;)  .FLOio'  .iPRAYdPT^l) 
IF(J(  K.riF.-<)  GO  TO  1000 

w-ITF  (A,14f») 

OFAii  (wommit.  l'=!n)  (CA‘^0(I)*  I = ).?0> 

• ivITF  (4.U0)  (CAPJ(I).  1 = 1.20) 

ISO  F()4-<AT  (?0A4) 

140  FnS-'“AT(l>'.?0A4) 

opwiMO  4ay^)IX 

inp=iop*i 

inr*’T  ( TOP)  af) 

OVP^!^  (1  .ir-p)ei 
PFALM30,  lOlU  nWAME 
pF»iT\n  HO 

IF  (O'JA'-'F.f  fj.nnNM-iE)  ITP1G0=1 
lF(n(|A'»F,F0,nilWA'1F)  IT^IGU=1 
IF  (i).MflMK  .ro.nnyA.v.t  ) 1S=2 

IF (niMAMf.Fo.noNAMr:)  is=i 

1N0V=1 
iMDPrJ 
GO  TO  ■=; 

looo  IFdrK.i.F.n.nj.rrip.LE.O)  go  to  1030 
IF  (IOC  IT(IOP) .LT.IO)  GO  TO  1025 
-.'PITF  (F,,  170) 

170  FOP»>'AT(//  t TOO  '^ANY  DO  OP  DU  FIFlUS  Th£SE  IGNORED') 

GO  TO  5 
10  25  CONTI  Nil' 

Pr.fttj  (PRii-nT.lSO)  (CA-Jiid),  1 = 1. ?0) 

■•'PITF.  (*.,100)  (CA40(I).  1 = 1.20) 

PF'‘  INn  pcyK.JT 

OVFPT  d^ '"/.  inp)  = AP-i'AYdPT  ♦ 1) 

TOLlK  = nv'FPT  ( junv.  I )F)  *2 
no  injo  I = 1.M|.IM 
rinv=iMiiv*i 

VFPTf  Y (TOT  V T 2.  I ) = a-J^-  AY  dPT*  1 ♦ 1 ) 

1010  l.)'/F«T  (I'N.0''.inP)  = ftwt-AYdPT  ♦ I ♦ 1) 

INOO  = INI'V  ♦ ) . 

T0TvT?  = T0TvTP*inU2 

00  l(i?o  1=1.4 
ODFCT ( TNOP . JOP) =FLOTNF ( I ) 
lOPO  pintsINOP.l 

lOCNT  ( Tn“)  alOCi.T  ( lOP)  *1 
ini)i  =iorNT  ( lOP)  *1 
oypl.'T  dou  i,  jop)  = iony 
GO  TO  G 

r FINIGHFI)  '.'ITH  IJO/  )|J  FI  FLO  PROCESSING 

1030  COOTIOlJF 

lOPsO 

inpPriTRiGo.iTpir.o 
IF(lCK.LT.t))(;0  TO  20 
IF  (ICK.FO.M)rvi  TO  ^n 
IF(Nori  .GT.fDGO  TO  4 
wPi re (4.400) 

CALI.  C‘’FPP 
4 COOTlr.ijF 

NWsftpoTY(TPT*l ) 
rjv/PTsNvi-T.  -jy 
NOFUi  = MilFl  ()♦  1 

NSA“k=  I s A-‘f '.'0-SA'TSTp  ) /SA'''lr 'C+  1 

Fl  OSAMau 

IPrlRf*'' 


RODUOHOO 

POOOOfllO 

Wijlju0tj20 

RODO0P30 

W0O00B40 

PIJOOOBSO 

POU00H40 

POU00H70 

POOOObBO 

kDDOOMBO 

R0000‘*00 

RDOU0910 

kOL)u0920 

ROOOO^JO 

ROO00V40 

^0000950 

KD000960 

RD000970 

Rn()00980 

ROU00990 

kOOOIOOO 

ROOOlOlO 

RD001020 

90001030 

PDOU1040 

RUD01050 

90001060 

90001070 

RODO1080 

R0OU1090 

RDDOllOO 


90001230 
90001240 
R1)U012SO 
90001260 
90001270 
RD001280 
PODO1290 
9D001300 
90001310 
90001320 
RDD01330 
RUUOl 340 
90001350 
90001360 
R0001370 
90001 380 
91)001390 
R00ul400 
R0D01410 
90001420 
9(1001430 
90001440 
R0O01450 
91)001460 
90001470 
Rooo 1480 
90001490 
90001500 
9')ij  i»  1 5 1 0 
91)  701520 
90001530 
9!.'Oiil540 
90O01550 
9Oi)01540 
9000 1570 
9UD01580 


filf:  RODPAT 


c« 

c« 

c* 


NQ»NV- 

TF<K'0.<^T.S)N0=5 
- 1 

kOITE  (^*«)no)\iOFl  D*  ARRAY  (IPT)  .SA  IMNC» 

» (LPO^'.  AO»AY  (I)  . ARRAYJl*  I = 

IF(N.i<,Le,n)GO  TO  7 
Iflalf ♦! 

fF*Ih*M*>*9  - 1 

WPITF  (*>.(S«;n)  (LOR^tARPAYm  .APRrtYd*!)  «I*Ib.IE*2) 

CONTI  Ml  IF 

IF(NSAMP*^'nFEAT.6T.I0lM)00  TO  '#0 

POSITION  tape  for  TMIS  field 

Call  FLOlNTIFLDlNF.FFTveC.NOFF.AT) 

FL0SAM=0 

DO  10  LINF=LINST«,LInEnD»LI.'JII'C 

LMD(l)=n 

LK'U(2)»n 

lOHP  = ? 

loEEsl 

IF  (lOPP.PO.O)  GO  TO  10R*i 

noth  00  iNO  on  triggers  OFF  SKIP  AROUND 

DO  lObO  1(0=1, lOPP 
lOL iMsTOCNT  (TND) 

DO  losn  l = J,.inLlN 
l^u^’=  ( i-l ) 

LOSTRsOt^FOT  ( lOUM*  1 . INO) 

LOFNtJs'^wFrT  ( TOU'*»^?,  INO) 

LOI'.jCsOJFrT  ( lOu*'**  I.InD) 

00  1040  IT  = 1 0PTR«LU£M»»L0INC 
IFdl.NF.i  IHP)  GO  TO  1040 
LNOdNO)  =1  NodNO)  ♦! 

I'-Uft-si  M|,  ( TfjO) 

Lf>OU(  lODM.  INO)  = I 
1040  CONTIMtt- 
JOSO  CONTIMIF 
1040  CONTjriilP 

IF  (L^'^(1>  .t-O.O.A  lO.LNOdODP)  .EO.O)  GO  TO  1095 
■ NO  no  OR  On  Po.’  Ti-tlS  lINP 
IF(LfiO(l  ) .GT.o)  IDbR=l 
IFdOPP.FO.f  .A>JO.LNO(^)  .GT.O)  10FPa2 
DO  noo  I*'0=IOHR,  IDEE 

inLI  x=|.MO(  i.jO) 

IF  dDLlf^.FO.o)  60  TO  1090 
100^=0 

0D]I!T(1.1>  = 1 
UPI'  T (1 ,?)  = 1 
on  1000  Isl.TOLIM 
inF=l  non  n . INO) 

OVRsOVO'iT  ( lf)F.  IND) 

CALL.  FOLI*'!  (0\/ERT<0VP*1,IN0)  , OVERT  (OVP.  INO)  ,FLtLlNE.SAMPS,Nl ) 
(^.OIN  T ( I , INI)  =n'I 
IF  (iJl.rO.a)  GO  TO  lOiiO 

on  1070  n = l«  'I 
OINT  ( II  + IC'.I  i.IN0)=FL(1I) 

iniiMsjr), 

r.pr'T  d*i . i-jO)  = I HUM  ♦ 1 
CONT  INI'P 
CONTiriif 

Cont immp 

CALI  I I(  PPH  ( lOATA  .P'lllTAO) 

IF  (ENOT/ P,t  :j.-l)6'1  TO  Pfi 


1070 


n-(o 

lOOO 

1095 


ru 

r* 

c* 

r* 

c* 

c* 


FINO  SAMPLE  T-'TFPGFCTS  EOP  THIS  LINF  - Nl=GO.  OF  INTERSECTS 

CALL  FOL lAT (ARRAY ( IPT  ♦?) .MV.FL.LInp.SamPS.NI ) 

STORE  hata  n>'  THIS  Li’it"  iNTn  onTRUT  RUFFEp 

mO|)SS  = '-«00  ( S i''''^TR«SAMlNC) 
nn  4(1  1 = 1,  M I , p 

To=(F|  r T ) -SA^STP) /SA  .'INC*1 
;F=(F|  n*1  )-S/\mSTr)  /SA'flMC*! 

IF  (‘•Onss.f‘E.'’'MHEL  ( I ) ,SA'11.  C)  ) lH  = Iri»l 
IF  ( l",GT  . lA  ) 

IF  ( JliPP.En.  i: ) GOTh  ? 

IFCLNOdGPH)  .P  J.U.A  |.,.t  nnn.iPf  ) .FC.(I)  i,r)TO  i'ObS 


ROD01590 


PDDOl 

PDDO 

PDDO 


bh 


PUO0|b30 
RD00tb40 
RD001650 
P000|660 
KOO0l(S70 
KDUOlbHO 
R0001690 
WOD0i700 
PU001710 
RODO1720 
HOUO j 730 
R0001740 
RI)Oo1750 
K0001760 
ROOO1770 
ROUUl7rtO 
RD0n}790 
PUO()l806 
RODOIHIO 
«Oi)OlH20 
pomdftso 
ROOD 1840 
R0001850 
RUOuiSEO 
R0001R70 
ROOOlBftO 
R0001H90 
Room  900 
(R0001910 
P0001920 
Room  930 
k0001940 
PI)OGi950 
MOD01960 
R0001970 
R0001930 
kDUu 1 990 
HOD02000 
RO0U2010 
RU002020 
90002030 
h0002040 
90002050 
9|).)02060 
9U002070 
900020RO 
R0002090 
9D002100 
RD002110 
9D002120 
91(002130 
p'J0((2140 
90002150 
90002160 
91)0021  70 
9001(21 80 
9i)0((2190 
9001(2200 
90002210 
900U2220 
90002230 
RDD02240 
P0i)02250 
KOIJ02260 
(*Oi)u2270 
kOOU22HO 


901)1)2290 
KOJU2300 
9Ojj2310 
P )0023?0 
90002330 
9lJi)U2j4,0 
90002350 
rI)Oo2  (50 
«U002370 


ORIGINAL  PAGE  IS 
OF  POOR  QUALfTY 


riLEJ  rtonpAT 


20il3 


2r.o« 


?nio 


?030 

?040 


?OSi» 

?oc;s 


40 

so 

^0 

10 


15 


c* 

c« 

r* 

?u 


PAGh  ;s 
OF  POOR  QUA[,n  V 


no  2050  If OelOMP. lOEt 
lnLIM«|.MO( 


tnLIM«|.MO(  INn) 
r (ini iM.Fo.o)  goto  2oso 
nsiTsi 

MFANOn»MEON  50 

lF(in»p.e''.inPE»  ouTo  2003 
irnMn.Fo.2)  TU5IT*? 

I F ( 1 NO . FO , 2 ) ME  a f lOOsMt  a^'IDU 
r,OTO  200Q 

lF(inps.Fr.l.AN0.10PO,E0.2)  GOTO  2009 

IFdTPK-U.eo.ni  OOTf)  2009 

losITs? 

MPaNorisMEaNiiu 

CO^TI^lllF 

IJO  ?il40  Krl.IOLlM 
•)>''I''t=Knia)T  (^.  INO) 

IF  (NrilN.eri.fl)  (jOTO  2040 
DPINsnoiNT (K« INO) 
on  2C10  KKsl.iDlN 
i,TN(HK)=niMT  (0PIN*KK-1  .IMO) 

IO(|M=0 

fjo  •sfipo  Kt- =1  .nOIN»2 
mif-'r  THflM*  1 

r>P  ( inn*  ) r (tlTN(irK)  -SAMSTP)  /S4mIwC*1 
'5p  ( it'll”)  r (If  Iff  (KK*1  ) -SA  ^5TM»/SAmIk|C*1 
F ("Oncs.NF.MOiXOIf'Kr.K)  .SAminC)  ) ID5  ( IDUM)  =IDB  ( lOUM)  ♦! 

GOMTlN'Ip 

no  2030  KKaNlOlIM 

lOSsinStKK) 

inprinF(KK) 

lF(ins.r,T.lF.')P.H.GT.IOF)  goto  2030 

IF  ( lOS.I.e.  I-f)  If5S=lB 

IF(Ii)F.GT.ir)  inKsie 

IF  ( If'iS.GT.  InF)  GOTO  2030 

on  2(i2S  kkk  = IOs*10F 

ur!0l'(  lMi>)=N')no(T'ji))  ♦! 

on  ?f|?3  = ] ."OFFAT 

OilMHYl  sK'KK  + i'iSAMP'f  (KKKK-1) 

inaTa (ouv”Yi ) sMFANno 

ConTInoi- 

cof  TiN'iie 

COnTTMIF 

JF (I  (1C  TT.ro. I .AMO.nOOu( INOl.GT.O)  OOFLaGsI 
IF(insiT.F0.2.ANi).  Ji)i)u( iriiD) .i>T.n)  ouflag=i 
COnT  IM'IF 

no0l  .'  = t 'OF|_  aG.O'lFL  AO 

JpASF  = (MFIMOk  - 1)*4 
IpUFa  = PilFSTZ*** 

Mi,.n<;a  r 'r'(ns*4 

no  Bn  J=I=-.IF 

n pcflMsf LOSftv*! 

or;  sn  k = i.,noFfat 

I f.'PO=  I WBO*  1 

rv  iM'«Y?= j+MS  nvp*  (K- 1 ) 

IPACK  r inaTa (Dii'^iiY?) 

(HIPMYO  = HASF  4 Ifvpn 

= LpACK(4) 

IT  nffjr.0.LT.THi|F4)  GO  TO  50 
T0T''|«I)  = T0Tv'-(0  4 I VPO 
IF  noTf'r(0.ljT.Ow')S4)  GO  TO  35 

fALl  P "P  J Tr-'  (.''i).vvFS.iP'5AV(|JFItJ0X)  .rtUf  SlZ-LSTAT  ID) 

a.iOPFS  = AHOUt-S  4 hIiFSIZ 
IF  (ISTAT  ( THfiF)  ,Fo.  1 ) GOTO  40 
INRPSO 
CONT INUF 
CONTI  Ml  IF 
Cfi'jTlMilF 

lOT  s TFT  ♦ NV*2  ♦ 2 
apPAY ( IPT  5 sFlosam 
no  IS  1=1.0 

lBT=IPT4l 

tVH  AY  (IFD  =FLOI‘iF  ( I ) 

IPT=IPT*1 

IF(IPT»3n  .GT.  OESFOV)GO  TO  70 
GO  TO  5 

CLASS  MAMS  CA'n)  r 'fCO'iNTF  P£o  - it'-'-’FAO  hp-VII;(iS  CAk[i  TO  ijfc'T  NAMt 


NnCL=f/)CL*l 


00002380 
P0O02390 
k0I)02400 
W0002410 
00002420 
OUO02430 
0DO02440 
00002450 
00002460 
00002470 
PD002480 
KOr)024VO 
00002500 
00002510 
kl)002520 
WU002S30 
00002540 
RD002550 
O0U02560 
00002570 
00002580 
RD002590 
H0002600 
W0002610 
POO02620 
RD002630 
POO02640 
K0002650 
F0002b60 
wDi)02670 
P0')02680 
pm)02690 
PDl)0270n 
kD'5o271  0 
W0002720 
Hi50u2730 
POOU2740 
HOD02750 
R0r>02  760 
KUU02770 
PI)[/02780 
PD002790 
80002800 
KOO02510 
80002820 
R0002H30 
81)002540 
80002850 
80.J02860 
80002870 
SUOOPHflO 
800028RO 
80002900 
80002910 
80002920 
80002430 
80002940 
80002950 
80002960 
80002970 
80002980 
80002990 
800031)00 
W0f)03(5  10 
80003020 
-r0003030 
80003040 
80003050 
kOiTO/DsO 
80U03070 

8i'OO308r, 

81)00  3090 

f*i)i)u3l  no 
8D0031  1 0 
801)1)3120 

8i)f  It)  3 1 jn 

8 l1  )ii  3 I 4 0 
80003150 
801)0  3160 


F1L€:  «»nt)HAT 


2b 


C* 


30 


31 


.OT.nRO  TO  25 

.inO)M<TCLS 

.30 

MXTCLS 

,1P0)NXTCLS 

30 

Ut  HUrFEH  ANO 

WXTCL5 


IF(NOCL 

RF.AD(30 

PFwlNin 

8n  TO  A 
LSNAM 
Pf  AO  ( 3fl 
PFwI-vf) 
GO  TO  3 
FMPTY  L 

LAST=1 


TOTwPOaTOTJwn^IwPO 

IF(TOTwPO.r,T.».^oSt» 


RfTUPN  TO  OROCESS  OaTa  FOR  TriIS  CLASS. 


TyW|)4  s T'.i^<n/4 
tf  (4*1 


GOTO  35 


uri)  iw.»n4  = l.(ROA  ♦ 1 

CA|  I C ; JiTt  ■(A)"-'FS.AORAY(^FINriX)  . I»RD4.LSTAT  ( 1 ) ) 
T0TPTS  = 1 OTvwD/i-'OFeAT 

jPT  = n-T  - For  ♦ 1 
IPA7  » (f  •T.>'40/4)  ♦ 1 
IF  ( T3rT*TnTS'T‘r.^e.o«0S)RETiJRN 


^,3lTf-  (-.,P/'0)^ 

IPT  = IPT  - Fi'l  ♦ 1 
pC’TLik'N 

35  »’W^^  (x.,?no)N-!OS 
C'LI  CMF5D 

70  wkITF.  (»'.  300)  &FSFRV 
CALL  CMLRR 
50  c'^ITF  (A.400) 

CALL  C'-iFoo 
«0  .t-  lTF  (5.700)  niH 
C»LI  C-OWP 

IdO  filpMAT  ( 1 OX  , A4) 

140  FOP^aT(///  • ntSlGNiJTED  OTHPR  0»  llNIOEKTirl  a^lL  FIELDS  INPUT'/) 

?0{)  FOP'-AT(*  T(0a  'AJCh  OATA  pFOUFSTEO — PI  XELS*  ( ChA'INEUS*  1 ) CANNOT  ExC 
*0* . 1 1 0) 

300  Fnp*-<AT('  <:T('PA(,F  oF'''ijl4(=  0 F(1h(  field  DEFINITION  INFORMATION  EXCEC 

* THE  OT'-FI.  S Ll  ''IT  OE'.IE) 

40(1  FORMAT  (••  (■--ii,-(,F-T  APF  hFACHFO  MFFOoE  FNO  of  FIELD') 

SOO  format  (//^nx  , 'Fif  LOS  TO  PF  ri.iisTF  = Fn  FOr  CL  asu  ' « 1 X . A5// 

« TTr. 'SA'-ri  E«  , '/TpO. 'FlfL’'  namE  ' » T jO.  ' iNC.  ' • 

* TA>';.'T'-i-.''.T73.'v/FPTICFS  (5AF.P|..K.L1nE) '/) 

F)0  0 EORmaT  (1  X . T 1 5,  I 3.T  44,T3h,  Ir,  T4S,  I4.T60. 

* S ( A 1 . 1 ^ . I , • , T 4 . ' ) ' . 1 X ) ) 

HSo  FOP‘-'AT(1X.ThO.S(A1.14.'.'.T4.')  '.IX)) 

700  FORMAT)'  '0  OF  PixFLS  TO  BE  UnRACKEO  HEk 

*0'l  LP'IT  oFt.iy,) 

rti'O  FORMAT)//  'TNPUT  EPPOR  - A CLASSNamE  CArJ 
"ROMP  OF  FTFLOS'/) 

RFTUPN 
End 


SCAN  EXCEEDS  THE  DiMtN 
'HIST  HE  I'-iPiJT  HEFOkt  A 


RDDO; 
hddo^ 

RUDO, 
WUUO, 
RDDO. 
R0003220 
R0003230 
R0003l40 
HUD03250 
RD003260 
HU003270 
WOJ03280 
MDO032R0 
WO0U3300 

WUD03330 

P0003350 

HD003350 

POJ03360 

Kt)O,)3370 

Rr'D(»33H0 

H0003J90 

ROD('340n 

P0003A10 

R0003420 

K0003430 

WLtOu3440 

RDU03450 

R0()03460 

Pl)')03470 

rDOO J4H0 

RD003490 
PDi)O3500 
EFROOO3S10 
RDDO JS20 
DSR0003S30 
WUD03S40 
R0OO3S50 
RO0o3'3b0 
RD0K3S70 
R0003S80 
R0003590 
RU003600 
PODOiSlO 
;'1rOD03620 
RD  )03630 
GkOu03640 
WDU03650 
RD003S60 
50003670 
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